      SUBROUTINE ROTOR2(OPTION,PSI,NBLD)
      INTEGER OPTION
      COMMON /RINPUT/TYPE,NBLADE,DEL3G,NTRIM0,NTRIM1,MU,LAMDA,MTIP,NBM,N-
     1TM,GIMBAL,GAMMA,OMEGA,RADIUS,SIGMA,OPAERO,MRAERO,BBLD,RROOT,INCOMP-
     2,T1C,T1S,T75,MPSI,MREV,OPMODE,OFFSET,MRMODE,NONROT,NCOLB,CONE,IB,D-
     3EL1,XFA,KPG,GGS,GQS(5),GPS(3),NCOLT,WT0,RFA,HSPRC,HSPRS,KPB(5),RPH-
     4,XPH,WTCH,WTSH,WTRH,WTC,WTS,WTR,NUGC,NUGS,KFLAP,KLAG,HINGE,KPIN,AT-
     5ANKP(5),DROOP,SWEEP,DEL2,DEL3,ZFA,VTIPN,DEBUGR,EPMODE,GLAG,LDAMP,E-
     6XDAMP,PHIPH,PHIPL,LDAMPC,MUY,MUZ,CHORD(51),XA(51),MASS(51),XI(51),-
     7THETA(51),ITHETA(51),TWIST(51),EIZZ(51),EIXX(51),GJ(51),XC(51),DEN-
     8SER,OPUNIR,ELAG,VTOT,KHLMDA,KFLMDA,ALFHP,PSIHP,T75IN,T1CIN,T1SIN,I-
     9RING,ROTATE,FDROOP,FSWEEP,DEL4,DEL5
      REAL MU,LAMDA,MTIP,IB,MASS,ITHETA,KPG,NUGC,NUGS,KPB,KFLAP,KLAG,LDA-
     1MP,LDAMPC,MUY,MUZ,KHLMDA,KFLMDA
      INTEGER OPAERO,GIMBAL,OPMODE,HINGE,DEBUGR,OPUNIR,ROTATE
      COMMON /MODES/ETA(5,2,51),ETAP(5,2,51),ETAPP(5,2,51),NU(5),ZETA(3,-
     151),ZETAP(3,51),WT(3),EFA(5,2),EFAP(5,2),EFAPP(5,2)
      REAL NU
      COMMON /BAERO/MQU(5),MQDZ(5),MQZ(5),MQL(5),MQDB(5),MQB(5),MQDQ(5,5-
     1),MQQ(5,5),MQP(5,3),MMU,MDZ,MZ,ML,MDB,MB,MDQ(5),MQ(5),MP(3),TU,TDZ-
     2,TZ,TL,TDB,TB,TDQ(5),TQ(5),TP(3),HU,HDZ,HZ,HL,HDB,HB,HDQ(5),HQ(5),-
     3HP(3),QU,QDZ,QZ,QL,QDB,QB,QDQ(5),QQ(5),QP(3),RR,RU,RDZ,RZ,RL,RDB,R-
     4B,RDQ(5),RQ(5),RP(3),MPU(3),MPDZ(3),MPZ(3),MPL(3),MPDB(3),MPB(3),M-
     5PDQ(3,5),MPQ(3,5),MPP(3,3),MPDP(3,3),FZ0,FX0
      REAL MQU,MQDZ,MQZ,MQL,MQDB,MQB,MQDQ,MQQ,MQP,MMU,MDZ,MZ,ML,MDB,MB,M-
     1DQ,MQ,MP,MPU,MPDZ,MPZ,MPL,MPDB,MPB,MPDQ,MPQ,MPP,MPDP
      COMMON /BINERT/   I0,SQ(5,2),IQA(5,2),SPA(3,2),IDQA(5),IDQP(5),IQ(-
     15),SQDDP(5,3),SQP(5,3),IQDQ(5,5),IP(3),SP(3,2),IPA(3,2),SPDDA(3),S-
     2PDDQ(3,5),SPQ(3,5),IPDDP(3,3),IPP(3,3),XATOR(3,2,51),DXATOR(3,5,2,-
     351),MASSB,IQDP(5),IDQA0
      REAL MASSB,I0,IQA,IDQA,IDQP,IQ,IQDQ,IP,IPA,IPDDP,IPP,IQDP,IDQA0
      COMMON /RCOEF/A2(30,30),A1(30,30),A0(30,30),AA2(30,6),AA1(30,6),AA-
     10(30,6),B(30,8),BG(30,3),C2(6,30),C1(6,30),C0(6,30),CA2(6,6),CA1(6-
     2,6),CA0(6,6),DG(6,3)
      INTEGER TEETER
      DIMENSION ZERO(4236),F(2,2)
      EQUIVALENCE (ZERO(1),A2(1,1)),(GIMBAL,TEETER)
      DO 1 I=1,4236
    1 ZERO(I)=0.
      H=1./FLOAT(NBLD)
      IRE=IFIX(ELAG*50.)+2
      DPSI=6.283185/FLOAT(NBLD)
      G=GAMMA*DENSER/FLOAT(NBLD)
      DO 4 JPSI=1,NBLD
      PSIM=FLOAT(JPSI)*DPSI+PSI
      CS=COS(PSIM)
      SN=SIN(PSIM)
      ONE=1.
      IF (JPSI .EQ. 1) ONE=-1.
      IF (OPTION .LT. 0) ONE=0.
      CALL INERT(PSIM)
      F(1,1)=H
      F(1,2)=H*ONE
      F(2,1)=H*ONE
      F(2,2)=H
      HONE=H*ONE
      DO 11 K=1,NBM
      DO 11 JK=1,2
      K1=(K-1)*2+JK
      C=IQ(K)*H
      A2(K1,K1)=A2(K1,K1)+C
      A1(K1,K1)=A1(K1,K1)+C*GQS(K)*NU(K)
      A0(K1,K1)=A0(K1,K1)+C*NU(K)**2
      DO 12 I=1,NBM
      C=IQDQ(K,I)+.5*GLAG*ETAP(K,2,IRE)*ETAP(I,2,IRE)
      DO 12 JI=1,2
      I1=(I-1)*2+JI
   12 A1(K1,I1)=A1(K1,I1)+2.*C*F(JK,JI)
      DO 13 I=1,NTM
      C=SQP(K,I)
      DDC=SQDDP(K,I)
      DO 13 JI=1,2
      I1=(I-1)*2+JI+15
      A2(K1,I1)=A2(K1,I1)-DDC*F(JK,JI)
   13 A0(K1,I1)=A0(K1,I1)-C*F(JK,JI)
      IF (JK .EQ. 1) GO TO 14
      C=IQA(K,1)*H
      A2(K1,25)=A2(K1,25)+C
      A0(K1,25)=A0(K1,25)+C
      AA2(K1,1)=AA2(K1,1)-SQ(K,2)*SN*HONE
      AA2(K1,2)=AA2(K1,2)+SQ(K,2)*CS*HONE
      AA2(K1,4)=AA2(K1,4)+C*SN*ONE
      AA2(K1,5)=AA2(K1,5)-C*CS*ONE
      AA1(K1,4)=AA1(K1,4)+2.*C*CS*ONE
      AA1(K1,5)=AA1(K1,5)+2.*C*SN*ONE
   14 IF (JK .EQ. 2) GO TO 15
      A2(K1,27)=A2(K1,27)+IQA(K,2)*H
      AA2(K1,3)=AA2(K1,3)+SQ(K,1)*H
      AA2(K1,6)=AA2(K1,6)+IQA(K,2)*H
   15 A1(K1,25)=A1(K1,25)-2.*IDQA(K)*F(JK,2)
      A1(K1,27)=A1(K1,27)+2.*IQDP(K)*F(JK,1)
      AA1(K1,6)=AA1(K1,6)+2.*IQDP(K)*F(JK,1)
   11 CONTINUE
      DO 21 K=1,NTM
      DO 21 JK=1,2
      K1=(K-1)*2+JK+15
      WTORS=WT(K)
      IF ((JK .EQ. 2) .AND. (K .EQ. 1)) WTORS=WTR
      DO 22 I=1,NBM
      C=SPQ(K,I)
      DDC=SPDDQ(K,I)
      IF (K .EQ. 1) C=C-KPB(I)*IP(1)*WTORS**2
      DO 22 JI=1,2
      I1=(I-1)*2+JI
      A2(K1,I1)=A2(K1,I1)-DDC*F(JK,JI)
   22 A0(K1,I1)=A0(K1,I1)-C*F(JK,JI)
      C=IP(K)*H
      A2(K1,K1)=A2(K1,K1)+C
      A1(K1,K1)=A1(K1,K1)+C*GPS(K)*WT(K)
      A0(K1,K1)=A0(K1,K1)+C*WTORS**2
      IF (K .EQ. 1) B(K1,JK)=B(K1,JK)+C*WTORS**2
      DO 23 I=1,NTM
      C=IPP(K,I)
      DDC=IPDDP(K,I)
      DO 23 JI=1,2
      I1=(I-1)*2+JI+15
      A2(K1,I1)=A2(K1,I1)+DDC*F(JK,JI)
   23 A0(K1,I1)=A0(K1,I1)+C*F(JK,JI)
      F1=F(JK,1)
      F2=F(JK,2)
      IF (K1 .NE. 17) GO TO 24
      C=IP(1)*WTR**2*H
      A0(17,25)=A0(17,25)+KPG*C
      A0(17,27)=A0(17,27)+(T1C*SN-T1S*CS)*ONE*C
   24 C=IPA(K,2)
      A2(K1,25)=A2(K1,25)-C*F2
      A0(K1,25)=A0(K1,25)-C*F2
      A1(K1,25)=A1(K1,25)-2.*SPDDA(K)*F2
      A2(K1,27)=A2(K1,27)+IPA(K,1)*F1
      AA2(K1,1)=AA2(K1,1)-SP(K,1)*SN*F1
      AA2(K1,2)=AA2(K1,2)+SP(K,1)*CS*F1
      AA2(K1,3)=AA2(K1,3)-SP(K,2)*F1
      AA2(K1,4)=AA2(K1,4)-C*SN*F1
      AA2(K1,5)=AA2(K1,5)+C*CS*F1
      AA2(K1,6)=AA2(K1,6)+IPA(K,1)*F1
      AA1(K1,4)=AA1(K1,4)-2.*C*CS*F1
      AA1(K1,5)=AA1(K1,5)-2.*C*SN*F1
   21 CONTINUE
      IF (TEETER .EQ. 0) GO TO 31
      DO 32 I=1,NBM
      C=IQA(I,1)*H
      DO 32 JI=1,2
      I1=(I-1)*2+JI
      IF (JI .EQ. 1) GO TO 32
      A2(25,I1)=A2(25,I1)+C
      A0(25,I1)=A0(25,I1)+C
   32 A1(25,I1)=A1(25,I1)+2.*IDQA(I)*F(2,JI)
      DO 33 I=1,NTM
      C=SPA(I,1)
      DO 33 JI=1,2
      I1=(I-1)*2+JI+15
      A2(25,I1)=A2(25,I1)-C*F(2,JI)
   33 A0(25,I1)=A0(25,I1)-C*F(2,JI)
      C=I0*H
      A2(25,25)=A2(25,25)+C
      A1(25,25)=A1(25,25)+C*GGS*SQRT(NUGC**2-.999)
      A0(25,25)=A0(25,25)+C*NUGC**2
      A1(25,27)=A1(25,27)+2.*IDQA0*HONE
      AA2(25,4)=AA2(25,4)+I0*SN*HONE
      AA2(25,5)=AA2(25,5)-I0*CS*HONE
      AA1(25,4)=AA1(25,4)+2.*I0*CS*HONE
      AA1(25,5)=AA1(25,5)+2.*I0*SN*HONE
   31 CONTINUE
      DO 41 I=1,NBM
      DO 41 JI=1,2
      I1=(I-1)*2+JI
      IF (JI .EQ. 2) GO TO 42
      A2(27,I1)=A2(27,I1)+IQA(I,2)*H
      C2(1,I1)=C2(1,I1)-SQ(I,1)*H
      C2(4,I1)=C2(4,I1)+IQA(I,2)*H
   42 IF (JI .EQ. 1) GO TO 43
      C=SQ(I,2)*HONE
      DC=IQA(I,1)*H
      C2(2,I1)=C2(2,I1)+2.*C*SN
      C2(3,I1)=C2(3,I1)+2.*C*CS
      C2(5,I1)=C2(5,I1)+2.*DC*CS
      C2(6,I1)=C2(6,I1)+2.*DC*SN
      C1(2,I1)=C1(2,I1)+4.*C*CS
      C1(3,I1)=C1(3,I1)-4.*C*SN
      C0(2,I1)=C0(2,I1)-2.*C*SN
      C0(3,I1)=C0(3,I1)-2.*C*CS
      C0(5,I1)=C0(5,I1)+2.*DC*CS
      C0(6,I1)=C0(6,I1)+2.*DC*SN
   43 F1=F(1,JI)
      A1(27,I1)=A1(27,I1)-2.*IDQP(I)*F1
      C1(4,I1)=C1(4,I1)-2.*IDQP(I)*F1
      C1(5,I1)=C1(5,I1)+4.*IDQA(I)*CS*F1
   41 C1(6,I1)=C1(6,I1)+4.*IDQA(I)*SN*F1
      DO 44 I=1,NTM
      DO 44 JI=1,2
      I1=(I-1)*2+JI+15
      F1=F(1,JI)
      C=SPA(I,1)
      A2(27,I1)=A2(27,I1)-SPA(I,2)*F1
      C2(4,I1)=C2(4,I1)-SPA(I,2)*F1
      C2(5,I1)=C2(5,I1)-2.*C*CS*F1
      C2(6,I1)=C2(6,I1)-2.*C*SN*F1
      C0(5,I1)=C0(5,I1)-2.*C*CS*F1
   44 C0(6,I1)=C0(6,I1)-2.*C*SN*F1
      C=I0*H
      A2(27,27)=A2(27,27)+C
      A1(27,25)=A1(27,25)-2.*IDQA0*HONE
      AA2(27,6)=AA2(27,6)+C
      C2(5,25)=C2(5,25)+2.*I0*CS*HONE
      C2(6,25)=C2(6,25)+2.*I0*SN*HONE
      C2(4,27)=C2(4,27)+C
      C1(4,25)=C1(4,25)-2.*IDQA0*HONE
      C1(5,27)=C1(5,27)+4.*IDQA0*CS*H
      C1(6,27)=C1(6,27)+4.*IDQA0*SN*H
      C0(5,25)=C0(5,25)+2.*I0*CS*HONE
      C0(6,25)=C0(6,25)+2.*I0*SN*HONE
      DDC=MASSB*H
      CA2(1,3)=CA2(1,3)-DDC
      CA2(2,1)=CA2(2,1)-2.*DDC
      CA2(3,2)=CA2(3,2)+2.*DDC
      CA2(4,6)=CA2(4,6)+C
      CA2(5,4)=CA2(5,4)+2.*C*CS*SN
      CA2(5,5)=CA2(5,5)-2.*C*CS*CS
      CA2(6,4)=CA2(6,4)+2.*C*SN*SN
      CA2(6,5)=CA2(6,5)-2.*C*CS*SN
      CA1(5,4)=CA1(5,4)+4.*C*CS*CS
      CA1(5,5)=CA1(5,5)+4.*C*CS*SN
      CA1(6,4)=CA1(6,4)+4.*C*CS*SN
      CA1(6,5)=CA1(6,5)+4.*C*SN*SN
      CALL AERO(PSIM)
      GS=G*SN
      GC=G*CS
      G2S=GS*2.
      G2C=GC*2.
      GS2=G*SN*SN*2.
      GC2=G*CS*CS*2.
      GCS=G*SN*CS*2.
      F(1,1)=G
      F(1,2)=G*ONE
      F(2,1)=G*ONE
      F(2,2)=G
      GONE=G*ONE
      DO 69 K=1,NBM
      DO 69 JK=1,2
      K1=(K-1)*2+JK
      F1=F(JK,1)
      F2=F(JK,2)
      DO 62 I=1,NBM
      C=MQQ(K,I)
      DC=MQDQ(K,I)
      DO 62 JI=1,2
      I1=(I-1)*2+JI
      A1(K1,I1)=A1(K1,I1)-DC*F(JK,JI)
   62 A0(K1,I1)=A0(K1,I1)-C*F(JK,JI)
      DO 63 I=1,NTM
      C=MQP(K,I)
      DO 63 JI=1,2
      I1=(I-1)*2+JI+15
   63 A0(K1,I1)=A0(K1,I1)-C*F(JK,JI)
      A1(K1,25)=A1(K1,25)-MQDB(K)*F2
      A0(K1,25)=A0(K1,25)-MQB(K)*F2
      DC=MQDB(K)*F1
      A1(K1,29)=A1(K1,29)-DC*CS
      A1(K1,30)=A1(K1,30)-DC*SN
      AA1(K1,4)=AA1(K1,4)-DC*SN
      AA1(K1,5)=AA1(K1,5)+DC*CS
      DC=MQDZ(K)*F1
      C=MQZ(K)*F1
      A1(K1,27)=A1(K1,27)-DC
      A0(K1,27)=A0(K1,27)-C
      AA1(K1,6)=AA1(K1,6)-DC
      AA0(K1,6)=AA0(K1,6)-C
      C=MQU(K)*F1
      DC=MQL(K)*F1
      A1(K1,28)=A1(K1,28)-DC
      AA1(K1,1)=AA1(K1,1)+C*SN
      AA1(K1,2)=AA1(K1,2)-C*CS
      AA1(K1,3)=AA1(K1,3)-DC
      AA0(K1,4)=AA0(K1,4)-C*LAMDA*CS+DC*MUY
      AA0(K1,5)=AA0(K1,5)+DC*MU-C*LAMDA*SN
      BG(K1,1)=BG(K1,1)+C*SN
      BG(K1,2)=BG(K1,2)+C*CS
      BG(K1,3)=BG(K1,3)-DC
   69 CONTINUE
      DO 79 K=1,NTM
      DO 79 JK=1,2
      K1=(K-1)*2+JK+15
      F1=F(JK,1)
      F2=F(JK,2)
      DO 72 I=1,NBM
      C=MPQ(K,I)
      DC=MPDQ(K,I)
      DO 72 JI=1,2
      I1=(I-1)*2+JI
      A1(K1,I1)=A1(K1,I1)-DC*F(JK,JI)
   72 A0(K1,I1)=A0(K1,I1)-C*F(JK,JI)
      DO 73 I=1,NTM
      DC=MPDP(K,I)
      C=MPP(K,I)
      DO 73 JI=1,2
      I1=(I-1)*2+JI+15
      A1(K1,I1)=A1(K1,I1)-DC*F(JK,JI)
   73 A0(K1,I1)=A0(K1,I1)-C*F(JK,JI)
      A1(K1,25)=A1(K1,25)-MPDB(K)*F2
      A0(K1,25)=A0(K1,25)-MPB(K)*F2
      DC=MPDB(K)*F1
      A1(K1,29)=A1(K1,29)-DC*CS
      A1(K1,30)=A1(K1,30)-DC*SN
      AA1(K1,4)=AA1(K1,4)-DC*SN
      AA1(K1,5)=AA1(K1,5)+DC*CS
      DC=MPDZ(K)*F1
      C=MPZ(K)*F1
      A1(K1,27)=A1(K1,27)-DC
      A0(K1,27)=A0(K1,27)-C
      AA1(K1,6)=AA1(K1,6)-DC
      AA0(K1,6)=AA0(K1,6)-C
      C=MPU(K)*F1
      DC=MPL(K)*F1
      A1(K1,28)=A1(K1,28)-DC
      AA1(K1,1)=AA1(K1,1)+C*SN
      AA1(K1,2)=AA1(K1,2)-C*CS
      AA1(K1,3)=AA1(K1,3)-DC
      AA0(K1,4)=AA0(K1,4)-C*LAMDA*CS+DC*MUY
      AA0(K1,5)=AA0(K1,5)+DC*MU-C*LAMDA*SN
      BG(K1,1)=BG(K1,1)+C*SN
      BG(K1,2)=BG(K1,2)+C*CS
      BG(K1,3)=BG(K1,3)-DC
   79 CONTINUE
      IF (TEETER .EQ. 0) GO TO 81
      DO 82 I=1,NBM
      C=MQ(I)
      DC=MDQ(I)
      DO 82 JI=1,2
      I1=(I-1)*2+JI
      A1(25,I1)=A1(25,I1)-DC*F(2,JI)
   82 A0(25,I1)=A0(25,I1)-C*F(2,JI)
      DO 83 I=1,NTM
      C=MP(I)
      DO 83 JI=1,2
      I1=(I-1)*2+JI+15
   83 A0(25,I1)=A0(25,I1)-C*F(2,JI)
      A1(25,25)=A1(25,25)-MDB*G
      A0(25,25)=A0(25,25)-MB*G
      A1(25,27)=A1(25,27)-MDZ*GONE
      A0(25,27)=A0(25,27)-MZ*GONE
      A1(25,28)=A1(25,28)-ML*GONE
      A1(25,29)=A1(25,29)-MDB*CS*GONE
      A1(25,30)=A1(25,30)-MDB*SN*GONE
      AA1(25,4)=AA1(25,4)-MDB*SN*GONE
      AA1(25,5)=AA1(25,5)+MDB*CS*GONE
      AA1(25,6)=AA1(25,6)-MDZ*GONE
      AA0(25,6)=AA0(25,6)-MZ*GONE
      C=MMU*GONE
      DC=ML*GONE
      AA1(25,1)=AA1(25,1)+C*SN
      AA1(25,2)=AA1(25,2)-C*CS
      AA1(25,3)=AA1(25,3)-DC
      AA0(25,4)=AA0(25,4)-C*LAMDA*CS+DC*MUY
      AA0(25,5)=AA0(25,5)+DC*MU-C*LAMDA*SN
      BG(25,1)=BG(25,1)+C*SN
      BG(25,2)=BG(25,2)+C*CS
      BG(25,3)=BG(25,3)-DC
   81 CONTINUE
      DO 60 I=1,NBM
      DO 60 JI=1,2
      I1=(I-1)*2+JI
      F1=F(1,JI)
      FC=F1*2.*CS
      FS=F1*2.*SN
      A1(27,I1)=A1(27,I1)+QDQ(I)*F1
      A1(28,I1)=A1(28,I1)-TDQ(I)*F1
      A1(29,I1)=A1(29,I1)-MDQ(I)*FC
      A1(30,I1)=A1(30,I1)-MDQ(I)*FS
      A0(27,I1)=A0(27,I1)+QQ(I)*F1
      A0(28,I1)=A0(28,I1)-TQ(I)*F1
      A0(29,I1)=A0(29,I1)-MQ(I)*FC
      A0(30,I1)=A0(30,I1)-MQ(I)*FS
      C1(1,I1)=C1(1,I1)+TDQ(I)*F1
      C1(2,I1)=C1(2,I1)+HDQ(I)*FS+RDQ(I)*FC
      C1(3,I1)=C1(3,I1)+HDQ(I)*FC-RDQ(I)*FS
      C1(4,I1)=C1(4,I1)+QDQ(I)*F1
      C1(5,I1)=C1(5,I1)-MDQ(I)*FC
      C1(6,I1)=C1(6,I1)-MDQ(I)*FS
      C0(1,I1)=C0(1,I1)+TQ(I)*F1
      C0(2,I1)=C0(2,I1)+HQ(I)*FS+RQ(I)*FC
      C0(3,I1)=C0(3,I1)+HQ(I)*FC-RQ(I)*FS
      C0(4,I1)=C0(4,I1)+QQ(I)*F1
      C0(5,I1)=C0(5,I1)-MQ(I)*FC
   60 C0(6,I1)=C0(6,I1)-MQ(I)*FS
      DO 70 I=1,NTM
      DO 70 JI=1,2
      I1=(I-1)*2+JI+15
      F1=F(1,JI)
      FC=F1*2.*CS
      FS=F1*2.*SN
      A0(27,I1)=A0(27,I1)+QP(I)*F1
      A0(28,I1)=A0(28,I1)-TP(I)*F1
      A0(29,I1)=A0(29,I1)-MP(I)*FC
      A0(30,I1)=A0(30,I1)-MP(I)*FS
      C0(1,I1)=C0(1,I1)+TP(I)*F1
      C0(2,I1)=C0(2,I1)+HP(I)*FS+RP(I)*FC
      C0(3,I1)=C0(3,I1)+HP(I)*FC-RP(I)*FS
      C0(4,I1)=C0(4,I1)+QP(I)*F1
      C0(5,I1)=C0(5,I1)-MP(I)*FC
   70 C0(6,I1)=C0(6,I1)-MP(I)*FS
      IF (TEETER .EQ. 0) GO TO 80
      F1=GONE
      FC=F1*2.*CS
      FS=F1*2.*SN
      A1(27,25)=A1(27,25)+QDB*F1
      A1(28,25)=A1(28,25)-TDB*F1
      A1(29,25)=A1(29,25)-MDB*FC
      A1(30,25)=A1(30,25)-MDB*FS
      A0(27,25)=A0(27,25)+QB*F1
      A0(28,25)=A0(28,25)-TB*F1
      A0(29,25)=A0(29,25)-MB*FC
      A0(30,25)=A0(30,25)-MB*FS
      C1(1,25)=C1(1,25)+TDB*F1
      C1(2,25)=C1(2,25)+HDB*FS+RDB*FC
      C1(3,25)=C1(3,25)+HDB*FC-RDB*FS
      C1(4,25)=C1(4,25)+QDB*F1
      C1(5,25)=C1(5,25)-MDB*FC
      C1(6,25)=C1(6,25)-MDB*FS
      C0(1,25)=C0(1,25)+TB*F1
      C0(2,25)=C0(2,25)+HB*FS+RB*FC
      C0(3,25)=C0(3,25)+HB*FC-RB*FS
      C0(4,25)=C0(4,25)+QB*F1
      C0(5,25)=C0(5,25)-MB*FC
      C0(6,25)=C0(6,25)-MB*FS
   80 A1(27,27)=A1(27,27)+QDZ*G
      A1(28,27)=A1(28,27)-TDZ*G
      A1(29,27)=A1(29,27)-MDZ*G2C
      A1(30,27)=A1(30,27)-MDZ*G2S
      A1(27,28)=A1(27,28)+QL*G
      A1(28,28)=A1(28,28)-TL*G
      A1(29,28)=A1(29,28)-ML*G2C
      A1(30,28)=A1(30,28)-ML*G2S
      A1(27,29)=A1(27,29)+QDB*GC
      A1(28,29)=A1(28,29)-TDB*GC
      A1(29,29)=A1(29,29)-MDB*GC2
      A1(30,29)=A1(30,29)-MDB*GCS
      A1(27,30)=A1(27,30)+QDB*GS
      A1(28,30)=A1(28,30)-TDB*GS
      A1(29,30)=A1(29,30)-MDB*GCS
      A1(30,30)=A1(30,30)-MDB*GS2
      A0(27,27)=A0(27,27)+QZ*G
      A0(28,27)=A0(28,27)-TZ*G
      A0(29,27)=A0(29,27)-MZ*G2C
      A0(30,27)=A0(30,27)-MZ*G2S
      AA1(27,1)=AA1(27,1)-QU*GS
      AA1(28,1)=AA1(28,1)+TU*GS
      AA1(29,1)=AA1(29,1)+MMU*GCS
      AA1(30,1)=AA1(30,1)+MMU*GS2
      AA1(27,2)=AA1(27,2)+QU*GC
      AA1(28,2)=AA1(28,2)-TU*GC
      AA1(29,2)=AA1(29,2)-MMU*GC2
      AA1(30,2)=AA1(30,2)-MMU*GCS
      AA1(27,3)=AA1(27,3)+QL*G
      AA1(28,3)=AA1(28,3)-TL*G
      AA1(29,3)=AA1(29,3)-ML*G2C
      AA1(30,3)=AA1(30,3)-ML*G2S
      AA1(27,4)=AA1(27,4)+QDB*GS
      AA1(28,4)=AA1(28,4)-TDB*GS
      AA1(29,4)=AA1(29,4)-MDB*GCS
      AA1(30,4)=AA1(30,4)-MDB*GS2
      AA1(27,5)=AA1(27,5)-QDB*GC
      AA1(28,5)=AA1(28,5)+TDB*GC
      AA1(29,5)=AA1(29,5)+MDB*GC2
      AA1(30,5)=AA1(30,5)+MDB*GCS
      AA1(27,6)=AA1(27,6)+QDZ*G
      AA1(28,6)=AA1(28,6)-TDZ*G
      AA1(29,6)=AA1(29,6)-MDZ*G2C
      AA1(30,6)=AA1(30,6)-MDZ*G2S
      AA0(27,4)=AA0(27,4)+QU*LAMDA*GC-QL*MUY*G
      AA0(28,4)=AA0(28,4)-TU*LAMDA*GC+TL*MUY*G
      AA0(29,4)=AA0(29,4)-MMU*LAMDA*GC2+ML*MUY*G2C
      AA0(30,4)=AA0(30,4)-MMU*LAMDA*GCS+ML*MUY*G2S
      AA0(27,5)=AA0(27,5)+QU*LAMDA*GS-QL*MU*G
      AA0(28,5)=AA0(28,5)-TU*LAMDA*GS+TL*MU*G
      AA0(29,5)=AA0(29,5)-MMU*LAMDA*GCS+ML*MU*G2C
      AA0(30,5)=AA0(30,5)-MMU*LAMDA*GS2+ML*MU*G2S
      AA0(27,6)=AA0(27,6)+QZ*G
      AA0(28,6)=AA0(28,6)-TZ*G
      AA0(29,6)=AA0(29,6)-MZ*G2C
      AA0(30,6)=AA0(30,6)-MZ*G2S
      BG(27,1)=BG(27,1)-QU*GS
      BG(28,1)=BG(28,1)+TU*GS
      BG(29,1)=BG(29,1)+MMU*GCS
      BG(30,1)=BG(30,1)+MMU*GS2
      BG(27,2)=BG(27,2)-QU*GC
      BG(28,2)=BG(28,2)+TU*GC
      BG(29,2)=BG(29,2)+MMU*GC2
      BG(30,2)=BG(30,2)+MMU*GCS
      BG(27,3)=BG(27,3)+QL*G
      BG(28,3)=BG(28,3)-TL*G
      BG(29,3)=BG(29,3)-ML*G2C
      BG(30,3)=BG(30,3)-ML*G2S
      C1(1,28)=C1(1,28)+TL*G
      C1(2,28)=C1(2,28)+HL*G2S+RL*G2C
      C1(3,28)=C1(3,28)+HL*G2C-RL*G2S
      C1(4,28)=C1(4,28)+QL*G
      C1(5,28)=C1(5,28)-ML*G2C
      C1(6,28)=C1(6,28)-ML*G2S
      C1(1,29)=C1(1,29)+TDB*GC
      C1(2,29)=C1(2,29)+HDB*GCS+RDB*GC2
      C1(3,29)=C1(3,29)+HDB*GC2-RDB*GCS
      C1(4,29)=C1(4,29)+QDB*GC
      C1(5,29)=C1(5,29)-MDB*GC2
      C1(6,29)=C1(6,29)-MDB*GCS
      C1(1,30)=C1(1,30)+TDB*GS
      C1(2,30)=C1(2,30)+HDB*GS2+RDB*GCS
      C1(3,30)=C1(3,30)+HDB*GCS-RDB*GS2
      C1(4,30)=C1(4,30)+QDB*GS
      C1(5,30)=C1(5,30)-MDB*GCS
      C1(6,30)=C1(6,30)-MDB*GS2
      C1(1,27)=C1(1,27)+TDZ*G
      C1(2,27)=C1(2,27)+HDZ*G2S+RDZ*G2C
      C1(3,27)=C1(3,27)+HDZ*G2C-RDZ*G2S
      C1(4,27)=C1(4,27)+QDZ*G
      C1(5,27)=C1(5,27)-MDZ*G2C
      C1(6,27)=C1(6,27)-MDZ*G2S
      C0(1,27)=C0(1,27)+TZ*G
      C0(2,27)=C0(2,27)+HZ*G2S+RZ*G2C
      C0(3,27)=C0(3,27)+HZ*G2C-RZ*G2S
      C0(4,27)=C0(4,27)+QZ*G
      C0(5,27)=C0(5,27)-MZ*G2C
      C0(6,27)=C0(6,27)-MZ*G2S
      CA1(1,1)=CA1(1,1)-TU*GS
      CA1(1,2)=CA1(1,2)+TU*GC
      CA1(1,3)=CA1(1,3)+TL*G
      CA1(1,4)=CA1(1,4)+TDB*GS
      CA1(1,5)=CA1(1,5)-TDB*GC
      CA1(1,6)=CA1(1,6)+TDZ*G
      CA1(2,1)=CA1(2,1)-HU*GS2-RU*GC2-RR*GCS
      CA1(2,2)=CA1(2,2)+HU*GCS-RU*GCS+RR*GC2
      CA1(2,3)=CA1(2,3)+HL*G2S+RL*G2C
      CA1(2,4)=CA1(2,4)+HDB*GS2+RDB*GCS
      CA1(2,5)=CA1(2,5)-HDB*GCS-RDB*GC2
      CA1(2,6)=CA1(2,6)+HDZ*G2S+RDZ*G2C
      CA1(3,1)=CA1(3,1)-HU*GCS+RU*GCS+RR*GS2
      CA1(3,2)=CA1(3,2)+HU*GC2+RU*GS2-RR*GCS
      CA1(3,3)=CA1(3,3)+HL*G2C-RL*G2S
      CA1(3,4)=CA1(3,4)+HDB*GCS-RDB*GS2
      CA1(3,5)=CA1(3,5)-HDB*GC2+RDB*GCS
      CA1(3,6)=CA1(3,6)+HDZ*G2C-RDZ*G2S
      CA1(4,1)=CA1(4,1)-QU*GS
      CA1(4,2)=CA1(4,2)+QU*GC
      CA1(4,3)=CA1(4,3)+QL*G
      CA1(4,4)=CA1(4,4)+QDB*GS
      CA1(4,5)=CA1(4,5)-QDB*GC
      CA1(4,6)=CA1(4,6)+QDZ*G
      CA1(5,1)=CA1(5,1)+MMU*GCS
      CA1(5,2)=CA1(5,2)-MMU*GC2
      CA1(5,3)=CA1(5,3)-ML*G2C
      CA1(5,4)=CA1(5,4)-MDB*GCS
      CA1(5,5)=CA1(5,5)+MDB*GC2
      CA1(5,6)=CA1(5,6)-MDZ*G2C
      CA1(6,1)=CA1(6,1)+MMU*GS2
      CA1(6,2)=CA1(6,2)-MMU*GCS
      CA1(6,3)=CA1(6,3)-ML*G2S
      CA1(6,4)=CA1(6,4)-MDB*GS2
      CA1(6,5)=CA1(6,5)+MDB*GCS
      CA1(6,6)=CA1(6,6)-MDZ*G2S
      HU1=HU*GS2+RU*GC2+RR*GCS
      HU2=HU*GCS-RU*GCS-RR*GS2
      HL1=HL*G2S+RL*G2C
      HL2=HL*G2C-RL*G2S
      CA0(1,4)=CA0(1,4)+TU*LAMDA*GC-TL*MUY*G
      CA0(1,5)=CA0(1,5)+TU*LAMDA*GS-TL*MU*G
      CA0(1,6)=CA0(1,6)+TZ*G
      CA0(2,4)=CA0(2,4)+LAMDA*(HU*GCS-RU*GCS+RR*GC2)-MUY*HL1
      CA0(2,5)=CA0(2,5)+LAMDA*HU1-MU*HL1
      CA0(2,6)=CA0(2,6)+HZ*G2S+RZ*G2C
      CA0(3,4)=CA0(3,4)+LAMDA*(HU*GC2+RU*GS2-RR*GCS)-MUY*HL2
      CA0(3,5)=CA0(3,5)+LAMDA*HU2-MU*HL2
      CA0(3,6)=CA0(3,6)+HZ*G2C-RZ*G2S
      CA0(4,4)=CA0(4,4)+QU*LAMDA*GC-QL*MUY*G
      CA0(4,5)=CA0(4,5)+QU*LAMDA*GS-QL*MU*G
      CA0(4,6)=CA0(4,6)+QZ*G
      CA0(5,4)=CA0(5,4)-MMU*LAMDA*GC2+ML*MUY*G2C
      CA0(5,5)=CA0(5,5)-MMU*LAMDA*GCS+ML*MU*G2C
      CA0(5,6)=CA0(5,6)-MZ*G2C
      CA0(6,4)=CA0(6,4)-MMU*LAMDA*GCS+ML*MUY*C2S
      CA0(6,5)=CA0(6,5)-MMU*LAMDA*GS2+ML*MU*G2S
      CA0(6,6)=CA0(6,6)-MZ*G2S
      DG(1,1)=DG(1,1)+TU*GS
      DG(1,2)=DG(1,2)+TU*GC
      DG(1,3)=DG(1,3)-TL*G
      DG(2,1)=DG(2,1)+HU1
      DG(2,2)=DG(2,2)+HU*GCS-RU*GCS+RR*GC2
      DG(2,3)=DG(2,3)-HL1
      DG(3,1)=DG(3,1)+HU2
      DG(3,2)=DG(3,2)+HU*GC2+RU*GS2-RR*GCS
      DG(3,3)=DG(3,3)-HL2
      DG(4,1)=DG(4,1)+QU*GS
      DG(4,2)=DG(4,2)+QU*GC
      DG(4,3)=DG(4,3)-QL*G
      DG(5,1)=DG(5,1)-MMU*GCS
      DG(5,2)=DG(5,2)-MMU*GC2
      DG(5,3)=DG(5,3)+ML*G2C
      DG(6,1)=DG(6,1)-MMU*GS2
      DG(6,2)=DG(6,2)-MMU*GCS
      DG(6,3)=DG(6,3)+ML*G2S
    4 CONTINUE
      C=2.*GAMMA*DENSER/(5.7*SIGMA)*(LAMDA-MUZ)/SQRT(LAMDA**2/KHLMDA**4+-
     1(MU**2+MUY**2)/KFLMDA**2)
      DC=C*MU/KFLMDA**2
      AA1(28,1)=AA1(28,1)-DC
      BG(28,1)=BG(28,1)-DC
      DC=C*MUY/KFLMDA**2
      AA1(28,2)=AA1(28,2)+DC
      BG(28,2)=BG(28,2)-DC
      DC=C*LAMDA/KHLMDA**4
      AA1(28,3)=AA1(28,3)+DC
      BG(28,3)=BG(28,3)+DC
      IF (ROTATE .EQ. -1) CALL REQROT
      RETURN
      END
      SUBROUTINE MODE
     2,T1C,T1S,T75,MPSI,MREV,OPMODE,OFFSET,MRMODE,NONROT,NCOLB,CONE,IB,D-
     1TM,GIMBAL,GAMMA,OMEGA,RADIUS,SIGMA,OPAERO,MRAERO,BBLD,RROOT,INCOMP-
     3EL1,XFA,KPG,GGS,GQS(5),GPS(3),NCOLT,WT0,RFA,HSPRC,HSPRS,KPB(5),RPH-
      COMMON /RINPUT/TYPE,NBLADE,DEL3G,NTRIM0,NTRIM1,MU,LAMDA,MTIP,NBM,N-
     4,XPH,WTCH,WTSH,WTRH,WTC,WTS,WTR,NUGC,NUGS,KFLAP,KLAG,HINGE,KPIN,AT-
     5ANKP(5),DROOP,SWEEP,DEL2,DEL3,ZFA,VTIPN,DEBUGR,EPMODE,GLAG,LDAMP,E-
     6XDAMP,PHIPH,PHIPL,LDAMPC,MUY,MUZ,CHORD(51),XA(51),MASS(51),XI(51),-
     7THETA(51),ITHETA(51),TWIST(51),EIZZ(51),EIXX(51),GJ(51),XC(51),DEN-
     8SER,OPUNIR,ELAG,VTOT,KHLMDA,KFLMDA,ALFHP,PSIHP,T75IN,T1CIN,T1SIN,I-
     9RING,ROTATE,FDROOP,FSWEEP,DEL4,DEL5
      REAL MU,LAMDA,MTIP,IB,MASS,ITHETA,KPG,NUGC,NUGS,KPB,KFLAP,KLAG,LDA-
     1MP,LDAMPC,MUY,MUZ,KHLMDA,KFLMDA
      INTEGER OPAERO,GIMBAL,OPMODE,HINGE,DEBUGR,OPUNIR,ROTATE
      COMMON /MODES/ETA(5,2,51),ETAP(5,2,51),ETAPP(5,2,51),NU(5),ZETA(3,-
     151),ZETAP(3,51),WT(3),EFA(5,2),EFAP(5,2),EFAPP(5,2)
      REAL NU
      NAMELIST /NLDB/ETA,ETAP,ETAPP,NU,ZETA,ZETAP,WT,EFA,EFAP,EFAPP,KPB
      DIMENSION ZERO(1874)
      EQUIVALENCE (ZERO(1),ETA(1,1,1))
      DATA CVERT/57.29578/
  999 FORMAT (//1X,'PITCH/BENDING COUPLING     KPB =',5(F9.5,3X))
  998 FORMAT (1X,'PITCH/GIMBAL COUPLING      KPG =',F9.5/1X,'GIMBAL FLAP-
     1 FREQUENCY (PER REV)     NUGC =',F8.4,10X,'NUGS =',F8.4)
  997 FORMAT (1X,'CONTROL SYSTEM STIFFNESS  (PER REV FREQ)     WT0 =',F8-
     1.4,5X,'WTC =',F8.4,5X,'WTS =',F8.4,5X,'WTR =',F8.4)
  996 FORMAT (1X,'ROTOR PARAMETERS',15X,'RFA =',F7.4,10X,'EFLAP =',F7.4,-
     110X,'ELAG =',F7.4/32X,'CONE  =',F7.3/32X,'DROOP =',F7.3,'  (',F7.3-
     2,'  AT T75=0)',10X,'FA DROOP =',F7.3/32X,'SWEEP =',F7.3,'  (',F7.3-
     4,'  AT T75=0)',10X,'FA SWEEP =',F7.3)
  995 FORMAT (1X,'COMPUTATION PARAMETERS', 5X,'NBM =',I2,10X,'NTM =',I2,-
     110X,'NBM-TRIM =',I2,' TO',I2/28X,'NCOLB =',I2, 8X,'NCOLT =',I2/28X-
     2,'MR-AERO =',I3, 5X,'MR-MODE =',I3, 5X,'MPSI-TRIM =',I3)
  994 FORMAT (1X,'LAG DAMPING (FT-LB-SEC OR M-N-SEC)  =',F8.0)
  967 FORMAT (2I10)
  966 FORMAT (5E15.7)
      IF (DEBUGR .EQ. 0) GO TO 40
      DO 41 I=1,1530
   41 ZERO(I)=0.
      DO 42 I=1536,1841
   42 ZERO(I)=0.
      DO 43 I=1845,1874
   43 ZERO(I)=0.
   40 IF (OPMODE .EQ. 2) GO TO 12
      IF ((OPMODE .EQ. 0) .OR. (OPMODE .EQ. 4)) GO TO 14
      GO TO 11
   12 READ (5,967) NBMR,NTMR
      READ (5,966) (NU(I),I=1,NBMR),(WT(I),I=1,NTMR),(KPB(I),I=1,NBMR), -
     1(((ETA  (I,J,JR), I=1,NBMR), J=1,2), JR=1,51),                    -
     2(((ETAP (I,J,JR), I=1,NBMR), J=1,2), JR=1,51),                    -
     3(((ETAPP(I,J,JR), I=1,NBMR), J=1,2), JR=1,51),                    -
     4((ZETA (I,JR), I=1,NTMR), JR=1,51),                               -
     5((ZETAP(I,JR), I=1,NTMR), JR=1,51),                               -
     6((EFA  (I,J), I=1,NBMR), J=1,2),                                  -
     7((EFAP (I,J), I=1,NBMR), J=1,2),                                  -
     8((EFAPP(I,J), I=1,NBMR), J=1,2)
      GO TO 11
   14 C1LAG=0.
      C2LAG=0.
      C1FLAP=0.
      C2FLAP=0.
      DO 15 JR=1,51
      R=FLOAT(JR-1)*.02
      X=(R-OFFSET)/(1.-OFFSET)
      XL=(R-ELAG)/(1.-ELAG)
      H=.02*MASS(51)
      IF (JR .EQ. 51) H=.5*H
      DO 16 J=1,2
      DO 16 JE=1,5
      ETA(JE,J,JR)=0.
      ETAP(JE,J,JR)=0.
   16 ETAPP(JE,J,JR)=0.
      IF (X .LT. 0.) GO TO 215
      ETA(2,1,JR)=X
      ETAP(2,1,JR)=1./(1.-OFFSET)
      C1FLAP=C1FLAP+H*X
      C2FLAP=C2FLAP+H*X*X
  215 IF (XL .LT. 0.) GO TO 15
      ETA(1,2,JR)=-XL
      ETAP(1,2,JR)=-1./(1.-ELAG)
      C1LAG=C1LAG+H*XL
      C2LAG=C2LAG+H*XL*XL
   15 CONTINUE
      DO 116 J=1,2
      DO 116 JE=1,5
      EFA(JE,J)=0.
      EFAP(JE,J)=0.
  116 EFAPP(JE,J)=0.
      X=(RFA-OFFSET)/(1.-OFFSET)
      XL=(RFA-ELAG)/(1.-ELAG)
      IF (X .LT. 0.) GO TO 216
      EFA(2,1)=X
      EFAP(2,1)=1./(1.-OFFSET)
  216 IF (XL .LT. 0.) GO TO 115
      EFA(1,2)=-XL
      EFAP(1,2)=-1./(1.-ELAG)
  115 CONTINUE
      IF (OPMODE .EQ. 0) GO TO 11
      NU(1)=(ELAG*C1LAG+KLAG/(OMEGA**2*RADIUS**3))/((1.-ELAG)*C2LAG)
      IF (NU(1) .GT. 0.) NU(1)=SQRT(NU(1))
      NU(2)=1.+(OFFSET*C1FLAP+KFLAP/(OMEGA**2*RADIUS**3))/((1.-OFFSET)*C-
     12FLAP)
      IF (NU(2) .GT. 0.) NU(2)=SQRT(NU(2))
   11 CALL BMODE
      CALL TMODE
      CSPH=COS((PHIPH+T75+PHIPL)/CVERT)
      IF (ABS(CSPH) .LT. .005) CSPH=.005
      IF (KPIN .LT. 0) CSPH=1.
      KPG=TAN(DEL3G/CVERT)/CSPH
      CSPL=COS(PHIPL/CVERT)
      SNPL=SIN(PHIPL/CVERT)
      DO 18 I=1,NBM
      IF (IABS(KPIN) .EQ. 1) GO TO 19
      KPB(I)=TAN(ATANKP(I)/CVERT)
      GO TO 18
   19 EI=EFA(I,1)-EFAP(I,1)*(RFA-RPH)
      EK=EFA(I,2)-EFAP(I,2)*(RFA-RPH)
      KPB(I)=(CSPL*EI+SNPL*EK)/(-XPH*CSPH)
   18 CONTINUE
      IF (OPMODE .NE. 3) GO TO 17
      NBMR=NBM
      NTMR=NTM
      WRITE (8,967) NBMR,NTMR
      WRITE(8,966) (NU(I),I=1,NBMR),(WT(I),I=1,NTMR),(KPB(I),I=1,NBMR), -
     1(((ETA  (I,J,JR), I=1,NBMR), J=1,2), JR=1,51),                    -
     2(((ETAP (I,J,JR), I=1,NBMR), J=1,2), JR=1,51),                    -
     3(((ETAPP(I,J,JR), I=1,NBMR), J=1,2), JR=1,51),                    -
     4((ZETA (I,JR), I=1,NTMR), JR=1,51),                               -
     5((ZETAP(I,JR), I=1,NTMR), JR=1,51),                               -
     6((EFA  (I,J), I=1,NBMR), J=1,2),                                  -
     7((EFAP (I,J), I=1,NBMR), J=1,2),                                  -
     8((EFAPP(I,J), I=1,NBMR), J=1,2)
   17 PRINT 999, (KPB(I), I=1,NBM)
      IF (GIMBAL .NE. 0) PRINT 998, KPG,NUGC,NUGS
      PRINT 997, WT(1),WTC,WTS,WTR
      DROOPA=DEL2*CVERT
      SWEEPA=DEL3*CVERT
      PRINT 996, RFA,OFFSET,ELAG,CONE,DROOPA,DROOP,FDROOP,SWEEPA,SWEEP,F-
     1SWEEP
      PRINT 995, NBM,NTM,NTRIM0,NTRIM1,NCOLB,NCOLT,MRAERO,MRMODE,MPSI
      IF (LDAMPC .NE. 0.) PRINT 994, LDAMPC
      IF (DEBUGR .NE. 0) WRITE(6,NLDB)
      RETURN
      END
      SUBROUTINE BMODE
      COMMON /RINPUT/TYPE,NBLADE,DEL3G,NTRIM0,NTRIM1,MU,LAMDA,MTIP,NBM,N-
     1TM,GIMBAL,GAMMA,OMEGA,RADIUS,SIGMA,OPAERO,MRAERO,BBLD,RROOT,INCOMP-
     2,T1C,T1S,T75,MPSI,MREV,OPMODE,OFFSET,MRMODE,NONROT,NCOLB,CONE,IB,D-
     3EL1,XFA,KPG,GGS,GQS(5),GPS(3),NCOLT,WT0,RFA,HSPRC,HSPRS,KPB(5),RPH-
     4,XPH,WTCH,WTSH,WTRH,WTC,WTS,WTR,NUGC,NUGS,KFLAP,KLAG,HINGE,KPIN,AT-
     5ANKP(5),DROOP,SWEEP,DEL2,DEL3,ZFA,VTIPN,DEBUGR,EPMODE,GLAG,LDAMP,E-
     6XDAMP,PHIPH,PHIPL,LDAMPC,MUY,MUZ,CHORD(51),XA(51),MASS(51),XI(51),-
     7THETA(51),ITHETA(51),TWIST(51),EIZZ(51),EIXX(51),GJ(51),XC(51),DEN-
     8SER,OPUNIR,ELAG,VTOT,KHLMDA,KFLMDA,ALFHP,PSIHP,T75IN,T1CIN,T1SIN,I-
     9RING,ROTATE,FDROOP,FSWEEP,DEL4,DEL5
      REAL MU,LAMDA,MTIP,IB,MASS,ITHETA,KPG,NUGC,NUGS,KPB,KFLAP,KLAG,LDA-
     1MP,LDAMPC,MUY,MUZ,KHLMDA,KFLMDA
      INTEGER OPAERO,GIMBAL,OPMODE,HINGE,DEBUGR,OPUNIR,ROTATE
      COMMON /MODES/ETA(5,2,51),ETAP(5,2,51),ETAPP(5,2,51),NU(5),ZETA(3,-
     151),ZETAP(3,51),WT(3),EFA(5,2),EFAP(5,2),EFAPP(5,2)
      REAL NU
      EQUIVALENCE (NCOL,NCOLB),(NBM,NMOD),(MR,MRMODE)
      COMMON /RCOEF/WORK(4236)
      COMPLEX FREQ2(20),MODAL(400)
      REAL A(400),A0(400),B(400),AH(400),AH0(400),FRQ(20)
      INTEGER LMINV(21),MMINV(21)
      EQUIVALENCE (A(1),WORK(1)),(A0(1),WORK(401)),(B(1),WORK(801)),(AH(-
     11),WORK(1201)),(AH0(1),WORK(1601)),(MODAL(1),WORK(2001)),(FREQ2(1)-
     2,WORK(2801)),(FRQ(1),WORK(2841)),(LMINV(1),WORK(2861)),(MMINV(1),W-
     3ORK(2882))
      REAL M2,M1,CENT(51),M75
  993 FORMAT (1H1,A4,' ROTOR   --   CANTILEVER BLADE MODES ',30X,'COLLEC-
     1TIVE PITCH    T75 =',F7.2/)
  994 FORMAT (1H1,A4,' ROTOR   --   ARTICULATED BLADE MODES',30X,'COLLEC-
     1TIVE PITCH    T75 =',F7.2/)
  999 FORMAT (5X,'FREQUENCY  (PER REV)  =',5F15.4)
  998 FORMAT ( 5X,'FREQUENCY    (HERTZ)  =',5F15.4)
  997 FORMAT (/5X,'MODE NUMBER',I3)
  996 FORMAT (10X,'ETA     IB',5X,11F8.3/18X,'KB',5X,11F8.3//10X,'ETAP  -
     1  IB',5X,11F8.3/18X,'KB',5X,11F8.3//10X,'ETAPP   IB',5X,11F8.3/18X-
     2,'KB',5X,11F8.3)
  995 FORMAT (//5X,'NONROTATING FREQUENCIES  (HERTZ)  =',5F15.4/40X,5F15-
     1.4)
  992 FORMAT (5X,'(RIGID, UNCOUPLED BLADE MODES)'/)
  991 FORMAT (5X,'(BLADE MODES READ FROM CARDS)'/)
      F(X,N)=(X**(N+1)*FLOAT((N+2)*(N+3))-2.*X**(N+2)*FLOAT(N*(N+3))+X**-
     1(N+3)*FLOAT(N*(N+1)))/6.                                          -
     2*AMIN0(1,N+HINGE-1)+AMAX0(0,2-N-HINGE)*X
      FP(X,N)=(X**N/FLOAT(N)-2.*X**(N+1)/FLOAT(N+1)+X**(N+2)/FLOAT(N+2))-
     1*FLOAT(N*(N+1)*(N+2)*(N+3))/6.                                    -
     2*AMIN0(1,N+HINGE-1)+AMAX0(0,2-N-HINGE)
      FPP(X,N)=(X**(N-1)-2.*X**N+X**(N+1))*FLOAT(N*(N+1)*(N+2)*(N+3))/6.-
     1*AMIN0(1,N+HINGE-1)
      IF ((OPMODE.EQ.0).OR.(OPMODE.EQ.2).OR.(OPMODE.EQ.4)) GO TO 50
      NCOL=MIN0(NCOL,10)
      DX=1./FLOAT(MR)
      DR=(1.-OFFSET)/FLOAT(MR)
      MR1=MR+1
      NCOL2=2*NCOL
      NCOLSQ=NCOL2**2
      IF (HINGE .NE. 0) HINGE=1
      M75=MASS(39)
      R2=1.
      M2=MASS(51)/M75
      CENT(MR1)=0.
      DO 21 JR=1,MR
      R1=1.-FLOAT(JR)*DR
      IR=IFIX(R1*50.+.5)+1
      M1=MASS(IR)/M75
      JR1=MR1-JR
      CENT(JR1)=CENT(JR1+1)+.5*DR*(R1*M1+R2*M2)
      R2=R1
   21 M2=M1
      DO 22 I=1,NCOLSQ
      A(I)=0.
      A0(I)=0.
   22 B(I)=0.
      IF (HINGE .NE. 0) GO TO 31
      A0(1)=KFLAP/(RADIUS**3*(1.-OFFSET)**2)
      J1=NCOL*(NCOL2+1)+1
      A0(J1)=KLAG/(RADIUS**3*(1.-OFFSET)**2)
   31 CONTINUE
      DO 23 JR=1,MR1
      R=FLOAT(JR-1)*DR+OFFSET
      IR=IFIX(R*50.+.5)+1
      X=FLOAT(JR-1)*DX
      IF (JR .EQ. 1) X=1.E-04
      H=DR
      IF ((JR .EQ. 1) .OR. (JR .EQ. MR1)) H=.5*DR
      SN=SIN(THETA(IR))
      CS=COS(THETA(IR))
      DO 23 I=1,NCOL
      DO 23 K=1,NCOL
      FI=FPP(X,I)
      FK=FPP(X,K)
      FPPR4=FK*FI/(RADIUS*(1.-OFFSET))**4/M75
      IF (K .GT. I) GO TO 24
      J1=(I-1)*NCOL2+K
      J2=J1+NCOL*(NCOL2+1)
      FI=F(X,I)
      FK=F(X,K)
      B(J1)=B(J1)+H*MASS(IR)*FI*FK/M75
      FI=FP(X,I)
      FK=FP(X,K)
      A(J1)=A(J1)+H*CENT(JR)*FK*FI/(1.-OFFSET)**2
      A0(J1)=A0(J1)+H*(EIZZ(IR)*CS*CS+EIXX(IR)*SN*SN)*FPPR4
      A0(J2)=A0(J2)+H*(EIZZ(IR)*SN*SN+EIXX(IR)*CS*CS)*FPPR4
   24 J3=(NCOL+I-1)*NCOL2+K
      A0(J3)=A0(J3)+H*(EIXX(IR)-EIZZ(IR))*SN*CS*FPPR4
   23 CONTINUE
      DO 25 I=1,NCOL
      DO 25 K=1,NCOL
      IF (K .GT. I) GO TO 25
      J1=(I-1)*NCOL2+K
      J2=J1+NCOL*(NCOL2+1)
      B(J2)=B(J1)
      A(J2)=A(J1)-B(J1)
   25 CONTINUE
      DO 26 K=1,NCOL2
      DO 26 I=1,NCOL2
      IF (I .GT. K) GO TO 26
      J1=(I-1)*NCOL2+K
      J2=(K-1)*NCOL2+I
      B(J1)=B(J2)
      A0(J1)=A0(J2)
      A(J1)=A(J2)
   26 CONTINUE
      DO 27 I=1,NCOLSQ
   27 A(I)=A(I)+A0(I)/OMEGA**2
      CALL MINV(B,NCOL2,DET,LMINV,MMINV)
      DO 28 I=1,NCOL2
      DO 28 K=1,NCOL2
      J1=(I-1)*NCOL2+K
      AH(J1)=0.
      AH0(J1)=0.
      DO 28 J=1,NCOL2
      J2=(J-1)*NCOL2+K
      J3=(I-1)*NCOL2+J
      AH(J1)=AH(J1)+B(J2)*A(J3)
   28 AH0(J1)=AH0(J1)+B(J2)*A0(J3)
      DO 29 I=1,NCOLSQ
      A(I)=AH(I)
   29 A0(I)=AH0(I)
      NEI=1
      CALL EIGEN(NEI,A,NCOL2,FREQ2,MODAL,NCOL2)
      FHOLD=-1.
      DO 41 JE=1,NMOD
      FMIN=1.E08
      DO 48 JC=1,NCOL2
      RE=REAL(FREQ2(JC))
      IF ((RE .GT. FMIN) .OR. (RE .LE. FHOLD)) GO TO 48
      JE1=JC
      FMIN=RE
   48 CONTINUE
      RE=REAL(FREQ2(JE1))
      NU(JE)=0.
      IF (RE .NE. 0.) NU(JE)=SQRT(ABS(RE))
      DO 42 JR=1,51
      X=(FLOAT(JR-1)*.02-OFFSET)/(1.-OFFSET)
      DO 43 I=1,2
      ETA  (JE,I,JR)=0.
      ETAP (JE,I,JR)=0.
   43 ETAPP(JE,I,JR)=0.
      IF (X .LT. 0.) GO TO 42
      IF (X .EQ. 0.) X=1.E-04
      DO 44 I=1,NCOL
      G=F(X,I)
      GP=FP(X,I)/(1.-OFFSET)
      GPP=FPP(X,I)/(1.-OFFSET)**2
      J1=(JE1-1)*NCOL2+I
      J2=J1+NCOL
      RE=REAL(MODAL(J1))
      ETA(JE,1,JR)=ETA(JE,1,JR)+RE*G
      ETAP(JE,1,JR)=ETAP(JE,1,JR)+RE*GP
      ETAPP(JE,1,JR)=ETAPP(JE,1,JR)+RE*GPP
      RE=REAL(MODAL(J2))
      ETA(JE,2,JR)=ETA(JE,2,JR)+RE*G
      ETAP(JE,2,JR)=ETAP(JE,2,JR)+RE*GP
   44 ETAPP(JE,2,JR)=ETAPP(JE,2,JR)+RE*GPP
   42 CONTINUE
      X=(RFA-OFFSET)/(1.-OFFSET)
      DO 143 I=1,2
      EFA(JE,I)=0.
      EFAP(JE,I)=0.
  143 EFAPP(JE,I)=0.
      IF (X .LT. 0.) GO TO 142
      IF (X .EQ. 0.) X=1.E-04
      DO 144 I=1,NCOL
      G=F(X,I)
      GP=FP(X,I)/(1.-OFFSET)
      GPP=FPP(X,I)/(1.-OFFSET)**2
      J1=(JE1-1)*NCOL2+I
      J2=J1+NCOL
      RE=REAL(MODAL(J1))
      EFA(JE,1)=EFA(JE,1)+RE*G
      EFAP(JE,1)=EFAP(JE,1)+RE*GP
      EFAPP(JE,1)=EFAPP(JE,1)+RE*GPP
      RE=REAL(MODAL(J2))
      EFA(JE,2)=EFA(JE,2)+RE*G
      EFAP(JE,2)=EFAP(JE,2)+RE*GP
  144 EFAPP(JE,2)=EFAPP(JE,2)+RE*GPP
  142 CONTINUE
      FHOLD=REAL(FREQ2(JE1))+.1
   41 CONTINUE
      DO 45 JE=1,NMOD
      Z=ETA(JE,1,51)
      X=ETA(JE,2,51)
      IF (ABS(Z) .GT. ABS(X)) EMAX=SIGN(1.,Z)/SQRT(Z*Z+X*X)
      IF (ABS(Z) .LE. ABS(X)) EMAX=-SIGN(1.,X)/SQRT(Z*Z+X*X)
      DO 145 I=1,2
      EFA(JE,I)=EFA(JE,I)*EMAX
      EFAP(JE,I)=EFAP(JE,I)*EMAX
  145 EFAPP(JE,I)=EFAPP(JE,I)*EMAX
      DO 45 JR=1,51
      DO 45 I=1,2
      ETA(JE,I,JR)=ETA(JE,I,JR)*EMAX
      ETAP(JE,I,JR)=ETAP(JE,I,JR)*EMAX
   45 ETAPP(JE,I,JR)=ETAPP(JE,I,JR)*EMAX
   50 IF (HINGE .EQ. 0) PRINT 994, TYPE,T75IN
      IF (HINGE .NE. 0) PRINT 993, TYPE,T75IN
      IF ((OPMODE.EQ.0).OR.(OPMODE.EQ.4)) PRINT 992
      IF (OPMODE .EQ. 2) PRINT 991
      PRINT 999, (NU(I), I=1,NMOD)
      DO 46 I=1,NMOD
   46 FRQ(I)=NU(I)*OMEGA*.1591549
      PRINT 998, (FRQ(I), I=1,NMOD)
      DO 47 JE=1,NMOD
      PRINT 997, JE
   47 PRINT 996, ((ETA(JE,I,JR), JR=1,51,5), I=1,2),                    -
     1           ((ETAP(JE,I,JR), JR=1,51,5), I=1,2),                   -
     2           ((ETAPP(JE,I,JR), JR=1,51,5), I=1,2)
      IF (NONROT .EQ. 0) RETURN
      NEI=0
      CALL EIGEN(NEI,A0,NCOL2,FREQ2,MODAL,NCOL2)
      DO 51 JE=1,NCOL2
      RE=REAL(FREQ2(JE))
      FRQ(JE)=0.
      IF (RE .NE. 0.) FRQ(JE)=SQRT(ABS(RE))*.1591549
   51 CONTINUE
      PRINT 995, (FRQ(I), I=1,NCOL2)
      RETURN
      END
      SUBROUTINE TMODE
      COMMON /RINPUT/TYPE,NBLADE,DEL3G,NTRIM0,NTRIM1,MU,LAMDA,MTIP,NBM,N-
     1TM,GIMBAL,GAMMA,OMEGA,RADIUS,SIGMA,OPAERO,MRAERO,BBLD,RROOT,INCOMP-
     2,T1C,T1S,T75,MPSI,MREV,OPMODE,OFFSET,MRMODE,NONROT,NCOLB,CONE,IB,D-
     3EL1,XFA,KPG,GGS,GQS(5),GPS(3),NCOLT,WT0,RFA,HSPRC,HSPRS,KPB(5),RPH-
     4,XPH,WTCH,WTSH,WTRH,WTC,WTS,WTR,NUGC,NUGS,KFLAP,KLAG,HINGE,KPIN,AT-
     5ANKP(5),DROOP,SWEEP,DEL2,DEL3,ZFA,VTIPN,DEBUGR,EPMODE,GLAG,LDAMP,E-
     6XDAMP,PHIPH,PHIPL,LDAMPC,MUY,MUZ,CHORD(51),XA(51),MASS(51),XI(51),-
     7THETA(51),ITHETA(51),TWIST(51),EIZZ(51),EIXX(51),GJ(51),XC(51),DEN-
     8SER,OPUNIR,ELAG,VTOT,KHLMDA,KFLMDA,ALFHP,PSIHP,T75IN,T1CIN,T1SIN,I-
     9RING,ROTATE,FDROOP,FSWEEP,DEL4,DEL5
      REAL MU,LAMDA,MTIP,IB,MASS,ITHETA,KPG,NUGC,NUGS,KPB,KFLAP,KLAG,LDA-
     1MP,LDAMPC,MUY,MUZ,KHLMDA,KFLMDA
      INTEGER OPAERO,GIMBAL,OPMODE,HINGE,DEBUGR,OPUNIR,ROTATE
      COMMON /MODES/ETA(5,2,51),ETAP(5,2,51),ETAPP(5,2,51),NU(5),ZETA(3,-
     151),ZETAP(3,51),WT(3),EFA(5,2),EFAP(5,2),EFAPP(5,2)
      REAL NU
      EQUIVALENCE (MR,MRMODE),(NCOL,NCOLT),(ETORS,RFA)
      COMPLEX FREQ2(5),MODAL(25)
      EQUIVALENCE (AH(1),MODAL(1))
      DIMENSION A(25),B(25),LMINV(6),MMINV(6),AH(25),FRQ(3)
      REAL I75
      DATA PI/3.141593/
  999 FORMAT (/   1X,'TORSION MODES'//5X,'FREQUENCY  (PER REV)  =',3F15.-
     14)
  998 FORMAT ( 5X,'FREQUENCY    (HERTZ)  =',3F15.4)
  997 FORMAT (/ 5X,'MODE NUMBER',I3)
  996 FORMAT (10X,'ZETA ',8X,11F8.3/10X,'ZETAP',8X,11F8.3)
      NCOL=MIN0(NCOL,5)
      NMOD=NTM-1
      DO 9 JR=1,51
      ZETA(1,JR)=1.
    9 ZETAP(1,JR)=0.
      FRQ(1)=WT(1)*OMEGA*.1591549
      IF (NMOD .EQ. 0) GO TO 32
      I75=ITHETA(39)
      FGJ=(OMEGA*RADIUS*(1.-ETORS))**2*I75
      DX=1./FLOAT(MR)
      DR=(1.-ETORS)/FLOAT(MR)
      MR1=MR+1
      NCOLSQ=NCOL*NCOL
      DO 10 I=1,NCOLSQ
      A(I)=0.
   10 B(I)=0.
      DO 11 JR=1,MR1
      R=ETORS+FLOAT(JR-1)*DR
      IR=IFIX(R*50.+.5)+1
      X=FLOAT(JR-1)*DX
      H=DR
      IF ((JR .EQ. 1) .OR. (JR .EQ. MR1)) H=.5*DR
      DO 11 I=1,NCOL
      DO 11 K=1,NCOL
      IF (K .GT. I) GO TO 11
      J=(I-1)*NCOL+K
      XXI=(FLOAT(I)-.5)*PI
      XK=(FLOAT(K)-.5)*PI
      SI=SIN(XXI*X)
      SK=SIN(XK*X)
      CI=COS(XXI*X)
      CK=COS(XK*X)
      B(J)=B(J)+H*ITHETA(IR)*SK*SI/I75
      A(J)=A(J)+H*GJ(IR)*CK*CI*XK*XXI/FGJ
   11 CONTINUE
      DO 12 I=1,NCOL
      DO 12 K=1,NCOL
      IF (K .GT. I) GO TO 12
      J1=(I-1)*NCOL+K
      J2=(K-1)*NCOL+I
      B(J2)=B(J1)
      A(J2)=A(J1)
   12 CONTINUE
      CALL MINV(B,NCOL,DET,LMINV,MMINV)
      DO 13 I=1,NCOL
      DO 13 K=1,NCOL
      J1=(I-1)*NCOL+K
      AH(J1)=0.
      DO 13 J=1,NCOL
      J2=(J-1)*NCOL+K
      J3=(I-1)*NCOL+J
   13 AH(J1)=AH(J1)+B(J2)*A(J3)
      DO 14 I=1,NCOLSQ
   14 A(I)=AH(I)
      NEI=1
      CALL EIGEN(NEI,A,NCOL,FREQ2,MODAL,NCOL)
      FHOLD=-1.
      DO 21 JE=1,NMOD
      FMIN=1.E08
      DO 26 JC=1,NCOL
      RE=REAL(FREQ2(JC))
      IF ((RE .GT. FMIN) .OR. (RE .LE. FHOLD)) GO TO 26
      JE1=JC
      FMIN=RE
   26 CONTINUE
      RE=REAL(FREQ2(JE1))
      WT(JE+1)=0.
      IF (RE .NE. 0.) WT(JE+1)=SQRT(ABS(RE))
      FRQ(JE+1)=WT(JE+1)*OMEGA*.1591549
      DO 22 JR=1,51
      X=(FLOAT(JR-1)*.02-ETORS)/(1.-ETORS)
      ZETA(JE+1,JR)=0.
      ZETAP(JE+1,JR)=0.
      IF (X .LT. 0.) GO TO 22
      DO 24 I=1,NCOL
      J=(JE1-1)*NCOL+I
      XXI=(FLOAT(I)-.5)*PI
      SI=SIN(XXI*X)
      CI=COS(XXI*X)
      RE=REAL(MODAL(J))
      ZETA(JE+1,JR)=ZETA(JE+1,JR)+RE*SI
   24 ZETAP(JE+1,JR)=ZETAP(JE+1,JR)+RE*CI*XXI/(1.-ETORS)
   22 CONTINUE
      FHOLD=REAL(FREQ2(JE1))+.1
   21 CONTINUE
      DO 25 JE=1,NMOD
      ZMAX=ZETA(JE+1,51)
      DO 25 JR=1,51
      ZETA(JE+1,JR)=ZETA(JE+1,JR)/ZMAX
   25 ZETAP(JE+1,JR)=ZETAP(JE+1,JR)/ZMAX
   32 IRFA=IFIX(RFA*50.+.5)+1
      DO 33 JR=1,IRFA
      DO 33 I=1,NTM
      IF (JR .EQ. IRFA) GO TO 33
      ZETAP(I,JR)=0.
   33 ZETA(I,JR)=0.
      ZETA(1,IRFA)=1.
      PRINT 999, (WT(I), I=1,NTM)
      PRINT 998, (FRQ(I), I=1,NTM)
      DO 31 JE=1,NTM
      PRINT 997, JE
   31 PRINT 996, (ZETA(JE,JR), JR=1,51,5),(ZETAP(JE,JR), JR=1,51,5)
      RETURN
      END
      SUBROUTINE RTRIM(ITERC,CTOS)
      COMMON /RINPUT/TYPE,NBLADE,DEL3G,NTRIM0,NTRIM1,MU,LAMDA,MTIP,NBM,N-
     1TM,GIMBAL,GAMMA,OMEGA,RADIUS,SIGMA,OPAERO,MRAERO,BBLD,RROOT,INCOMP-
     2,T1C,T1S,T75,MPSI,MREV,OPMODE,OFFSET,MRMODE,NONROT,NCOLB,CONE,IB,D-
     3EL1,XFA,KPG,GGS,GQS(5),GPS(3),NCOLT,WT0,RFA,HSPRC,HSPRS,KPB(5),RPH-
     4,XPH,WTCH,WTSH,WTRH,WTC,WTS,WTR,NUGC,NUGS,KFLAP,KLAG,HINGE,KPIN,AT-
     5ANKP(5),DROOP,SWEEP,DEL2,DEL3,ZFA,VTIPN,DEBUGR,EPMODE,GLAG,LDAMP,E-
     6XDAMP,PHIPH,PHIPL,LDAMPC,MUY,MUZ,CHORD(51),XA(51),MASS(51),XI(51),-
     7THETA(51),ITHETA(51),TWIST(51),EIZZ(51),EIXX(51),GJ(51),XC(51),DEN-
     8SER,OPUNIR,ELAG,VTOT,KHLMDA,KFLMDA,ALFHP,PSIHP,T75IN,T1CIN,T1SIN,I-
     9RING,ROTATE,FDROOP,FSWEEP,DEL4,DEL5
      REAL MU,LAMDA,MTIP,IB,MASS,ITHETA,KPG,NUGC,NUGS,KPB,KFLAP,KLAG,LDA-
     1MP,LDAMPC,MUY,MUZ,KHLMDA,KFLMDA
      INTEGER OPAERO,GIMBAL,OPMODE,HINGE,DEBUGR,OPUNIR,ROTATE
      COMMON /MODES/ETA(5,2,51),ETAP(5,2,51),ETAPP(5,2,51),NU(5),ZETA(3,-
     151),ZETAP(3,51),WT(3),EFA(5,2),EFAP(5,2),EFAPP(5,2)
      REAL NU
      COMMON /ZTRIM/B0(5),B1C(5),B1S(5),B2C(5),B2S(5),BGC,BGS,CT,CH,CY,C-
     1MX,CMY,CQ,JREV,ALPHA(36,51),FBC(36),FBS(36),FCT(36),FCQ(36),FCH(36-
     2),FCY(36),FCMX(36),FCMY(36),FQ(5,36),I0,IQ(5),IQ0(5),MQDQ(5),MQP0(-
     35),MDB,MP0,FG(2,2),SPRING(5),DAMP(5)
      REAL I0,IQ,IQ0,MQDQ,MQP0,MDB,MP0
      REAL M1,MACH,IQDQ(5,5),SUMB(5),Q(5),DQ(5),FQH(5),MUCS,MUSN
      INTEGER OUT
      DATA CVERT/57.29578/
      GAMMB=GAMMA*DENSER
      CMEAN=3.141593*SIGMA/FLOAT(NBLADE)
      DPSI=6.283185/FLOAT(MPSI)
      MR1=MRAERO+1
      DR=(1.-RROOT)/FLOAT(MRAERO)
      IRE= IFIX(ELAG*50.)+2
      IF (ITERC .NE. 1) GO TO 110
      I0=0.
      DO 111 K=NTRIM0,NTRIM1
      IQ(K)=0.
      IQ0(K)=0.
      MQP0(K)=0.
  111 MQDQ(K)=0.
      H=.02/IB*RADIUS**3
      HA=.02
      DO 112 JR=2,51
      R=FLOAT(JR-1)*.02
      U=SQRT(R*R+LAMDA*LAMDA)
      RMRFA=AMAX1(0.,R-RFA)
      IF (JR .EQ. 51) H=.5*H
      IF (JR .EQ. 51) HA=.01
      M1=MASS(JR)
      I0=I0+H*R*R*M1
      DO 112 K=NTRIM0,NTRIM1
      EI=ETA(K,1,JR)
      EK=ETA(K,2,JR)
      IQ(K)=IQ(K)+H*M1*(EI**2+EK**2)
      IQ0(K)=IQ0(K)+H*M1*(-EI*R*(DEL1-DEL2)+EK*XFA-RMRFA*(DEL2*EFA(K,1)+-
     1DEL3*EFA(K,2)))
      MQP0(K)=MQP0(K)+HA*.5*U*(R*EI-LAMDA*EK)
  112 MQDQ(K)=MQDQ(K)-HA*(.5*R*R/U*EI*EI+(.5*LAMDA/U*(LAMDA+R*CTOS)+.001-
     158*R)*EK*EK+(-R*LAMDA/U+.5/U*CTOS*(1.-R*R))*EI*EK)
      DO 113 K=NTRIM0,NTRIM1
      IQ0(K)=IQ0(K)/IQ(K)
      SPRING(K)=NU(K)**2+KPB(K)*GAMMB*MQP0(K)/IQ(K)
  113 DAMP(K)=GQS(K)*NU(K)+GLAG*ETAP(K,2,IRE)**2/IQ(K)-GAMMB*MQDQ(K)/IQ(-
     1K)
      U=SQRT(1.+LAMDA*LAMDA)
      MP0=.0625*U*(2.+LAMDA*LAMDA)-.0625*LAMDA**4*ALOG(ABS((1.+U)/LAMDA)-
     1)
      MDB=-.5*U*(.25-.375*LAMDA*LAMDA)-.1875*LAMDA**4*ALOG(ABS((1.+U)/LA-
     1MDA))
      CNC=(I0*(NUGC**2-1.)+KPG*GAMMB*MP0)/(-GAMMB*MDB)
      CNS=(I0*(NUGS**2-1.)+KPG*GAMMB*MP0)/(-GAMMB*MDB)
      FG(1,1)=CNS/(1.+CNC*CNS)
      FG(1,2)=-1./(1.+CNC*CNS)
      FG(2,1)= 1./(1.+CNC*CNS)
      FG(2,2)=CNC/(1.+CNC*CNS)
      DO 114 JP=1,MPSI
      FBC(JP)=0.
      FBS(JP)=0.
      FCT(JP)=0.
      FCQ(JP)=0.
      FCH(JP)=0.
      FCY(JP)=0.
      FCMX(JP)=0.
      FCMY(JP)=0.
      DO 114 JE=NTRIM0,NTRIM1
  114 FQ(JE,JP)=0.
  110 CONTINUE
      IF (VTOT .EQ. 0.) GO TO 116
      DO 118 JE=NTRIM0,NTRIM1
      B0(JE)=0.
      B1C(JE)=0.
      B1S(JE)=0.
      B2C(JE)=0.
      B2S(JE)=0.
      DO 118 JP=1,MPSI
      PSI=FLOAT(JP)*DPSI
      CS=COS(PSI)
      SN=SIN(PSI)
      CS2=CS*CS-SN*SN
      SN2=2.*CS*SN
      DF=FQ(JE,JP)/FLOAT(MPSI)
      B0(JE)=B0(JE)+DF/SPRING(JE)
      DEN=(SPRING(JE)-1.)**2+DAMP(JE)**2
      CNC=2.*(SPRING(JE)-1.)/DEN
      CNS=2.*DAMP(JE)/DEN
      B1C(JE)=B1C(JE)+DF*(CNC*CS-CNS*SN)
      B1S(JE)=B1S(JE)+DF*(CNS*CS+CNC*SN)
      DEN=(SPRING(JE)-4.)**2+4.*DAMP(JE)**2
      CNC=2.*(SPRING(JE)-4.)/DEN
      CNS=4.*DAMP(JE)/DEN
      B2C(JE)=B2C(JE)+DF*(CNC*CS2-CNS*SN2)
  118 B2S(JE)=B2S(JE)+DF*(CNS*CS2+CNC*SN2)
  116 CONTINUE
      CT=0.
      CQ=0.
      CH=0.
      CY=0.
      CMX=0.
      CMY=0.
      BGC=0.
      BGS=0.
      IF (VTOT .EQ. 0.) GO TO 119
      DO 117 JP=1,MPSI
      CT=CT+FCT(JP)
      CQ=CQ+FCQ(JP)
      CH=CH+FCH(JP)
      CY=CY+FCY(JP)
      CMX=CMX+FCMX(JP)
      CMY=CMY+FCMY(JP)
      BGC=BGC+FBC(JP)
  117 BGS=BGS+FBS(JP)
  119 CONTINUE
      DO 115 JE=NTRIM0,NTRIM1
      SUM=B0(JE)**2+.5*(B1C(JE)**2+B1S(JE)**2+B2C(JE)**2+B2S(JE)**2)
  115 IF (SUM .NE. 0.) SUMB(JE)=SQRT(SUM)
      SUM=(.5*(BGC**2+BGS**2))
      IF (SUM .NE. 0.) SUMBG=SQRT(SUM)
      IF (VTOT .NE. 0.) GO TO 400
      DPSI=0.
      DO 401 JREV=1,MREV
      DO 421 JE=NTRIM0,NTRIM1
  421 FQH(JE)=0.
      CT=0.
      CQ=0.
      DO 403 JR=1,MR1
      R=FLOAT(JR-1)*DR+RROOT
      IR=IFIX(R*50.+.5)+1
      H=DR
      IF ((JR .EQ. 1) .OR. (JR .EQ. MR1)) H=.5*DR
      H=H*CHORD(IR)/CMEAN
      HC=H*5.7
      UT=R
      UP=LAMDA
      T=THETA(IR)
      DO 431 JE=NTRIM0,NTRIM1
  431 T=T-KPB(JE)*B0(JE)
      ALF=T-ATAN2(UP,UT)
      ALPHA(1,JR)=ALF*CVERT
      U=SQRT(UT*UT+UP*UP)
      MACH=MTIP*U
      CALL SEXION(ALF,MACH,CL,XX1,XX2,CD,XX3,XX4,XX5,XX6,XX7,OPAERO,R)
      IF (R .GT. BBLD) CL=CL*AMAX1(0.,1.-2.*(1.-BBLD)/DR)
      FZ=U*(UT*CL-UP*CD)
      FX=U*(UP*CL+UT*CD)
      DO 433 JE=NTRIM0,NTRIM1
  433 FQH(JE)=FQH(JE)+H*(FZ*ETA(JE,1,IR)-FX*ETA(JE,2,IR))
      CT=CT+HC*FZ
      CQ=CQ+HC*FX*R
  403 CONTINUE
      DO 422 JE=NTRIM0,NTRIM1
  422 B0(JE)=(GAMMB*FQH(JE)/IQ(JE)+IQ0(JE))/NU(JE)**2
      OUT=MAX0(0,2-JREV)
      DO 412 JE=NTRIM0,NTRIM1
      IF (ABS(B0(JE)-SUMB(JE)) .GT. EPMODE) OUT=1
  412 SUMB(JE)=B0(JE)
      IF (OUT .EQ. 0) GO TO 404
  401 CONTINUE
  404 GO TO 4
  400 DO 1 JREV=1,MREV
      DO 11 K=NTRIM0,NTRIM1
      DO 11 I=NTRIM0,NTRIM1
      IQDQ(K,I)=0.
      H=.02/IB*RADIUS**3/IQ(K)
      DO 11 JR=2,51
      IF (JR .EQ. 51) H=.5*H
      EI=ETA(I,2,JR)
      EK=ETA(K,2,JR)
      M1=MASS(JR)*H
      IQDQ(K,I)=IQDQ(K,I)+((ETA(K,1,JR)*EI-ETA(I,1,JR)*EK)*(DEL1-DEL2)+E-
     1I*(EFA(K,1)*DEL2+EFA(K,2)*DEL3))*M1
      DO 11 JE=NTRIM0,NTRIM1
   11 IQDQ(K,I)=IQDQ(K,I)+B0(JE)*(ETA(JE,1,JR)*(-EK*ETAP(I,1,JR)+EI*ETAP-
     1(K,1,JR))+ETA(JE,2,JR)*(-EK*ETAP(I,2,JR)+EI*ETAP(K,2,JR)))*M1
      DO 2 JP=1,MPSI
      PSI=FLOAT(JP)*DPSI
      CS=COS(PSI)
      SN=SIN(PSI)
      CS2=CS*CS-SN*SN
      SN2=2.*CS*SN
      MUCS=MU*CS-MUY*SN
      MUSN=MU*SN+MUY*CS
      BETA=BGC*CS+BGS*SN
      DBETA=-BGC*SN+BGS*CS
      DO 21 JE=NTRIM0,NTRIM1
      Q(JE)=B0(JE)+B1C(JE)*CS+B1S(JE)*SN+B2C(JE)*CS2+B2S(JE)*SN2
      DQ(JE)=-B1C(JE)*SN+B1S(JE)*CS-2.*B2C(JE)*SN2+2.*B2S(JE)*CS2
   21 FQH(JE)=0.
      FCTH=0.
      FCQH=0.
      FCHH=0.
      FCYH=0.
      FCMXH=0.
      FCMYH=0.
      DO 3 JR=1,MR1
      R=FLOAT(JR-1)*DR+RROOT
      IR=IFIX(R*50.+.5)+1
      H=DR
      IF ((JR .EQ. 1) .OR. (JR .EQ. MR1)) H=.5*H
      H=H*CHORD(IR)/CMEAN
      HC=H/FLOAT(MPSI)*5.7
      T=THETA(IR)+T1C*CS+T1S*SN-KPG*BETA
      UT=R+MUSN-MUCS*DEL3
      UP=LAMDA+R*DBETA
      UR=MUCS+XFA+RFA*DEL3+MUSN*DEL3
      SLOPE=BETA+DEL1-DEL2
      DO 32 JE=NTRIM0,NTRIM1
      QH=Q(JE)
      DQH=DQ(JE)
      T=T-KPB(JE)*QH
      UT=UT+MUCS *QH*ETAP(JE,2,IR)+DQH*ETA(JE,2,IR)
      UP=UP+DQH*ETA(JE,1,IR)
      UR=UR+QH*(ETA(JE,2,IR)-(R+MUSN )*ETAP(JE,2,IR))
   32 SLOPE=SLOPE+QH*ETAP(JE,1,IR)
      UP=UP+MUCS*SLOPE
      UR=UR-LAMDA*SLOPE
      ALF=T-ATAN2(UP,UT)
      ALPHA(JP,JR)=ALF*CVERT
      U=SQRT(UT*UT+UP*UP)
      MACH=MTIP*U
      CALL SEXION(ALF,MACH,CL,XX1,XX2,CD,XX3,XX4,XX5,XX6,XX7,OPAERO,R)
      IF (R .GT. BBLD) CL=CL*AMAX1(0.,1.-2.*(1.-BBLD)/DR)
      FZ=U*(UT*CL-UP*CD)
      FX=U*(UP*CL+UT*CD)
      FR=U*UR*CD
      DO 33 JE=NTRIM0,NTRIM1
   33 FQH(JE)=FQH(JE)+H*(FZ*ETA(JE,1,IR)-FX*ETA(JE,2,IR))
      FCTH=FCTH+HC*FZ
      FCQH=FCQH+HC*FX*R
      FCHH=FCHH+HC*(SN*FX+CS*(FR-FZ*SLOPE))
      FCYH=FCYH-HC*(CS*FX-SN*(FR-FZ*SLOPE))
      FCMXH=FCMXH+HC*SN*FZ*R
      FCMYH=FCMYH-HC*CS*FZ*R
    3 CONTINUE
      DO 22 JE=NTRIM0,NTRIM1
      FQH(JE)=GAMMB*(FQH(JE)-MQDQ(JE)*DQ(JE)+KPB(JE)*MQP0(JE)*Q(JE))/IQ(-
     1JE)+IQ0(JE)
      DO 22 K=NTRIM0,NTRIM1
      CNC=2.*IQDQ(JE,K)
      IF (JE .NE. K) CNC=CNC+GLAG*ETAP(JE,2,IRE)*ETAP(K,2,IRE)/IQ(JE)
   22 FQH(JE)=FQH(JE)-CNC*DQ(K)
      DO 23 JE=NTRIM0,NTRIM1
      DF=(FQH(JE)-FQ(JE,JP))/FLOAT(MPSI)
      B0(JE)=B0(JE)+DF/SPRING(JE)
      DEN=(SPRING(JE)-1.)**2+DAMP(JE)**2
      CNC=2.*(SPRING(JE)-1.)/DEN
      CNS=2.*DAMP(JE)/DEN
      B1C(JE)=B1C(JE)+DF*(CNC*CS-CNS*SN)
      B1S(JE)=B1S(JE)+DF*(CNS*CS+CNC*SN)
      DEN=(SPRING(JE)-4.)**2+4.*DAMP(JE)**2
      CNC=2.*(SPRING(JE)-4.)/DEN
      CNS=4.*DAMP(JE)/DEN
      B2C(JE)=B2C(JE)+DF*(CNC*CS2-CNS*SN2)
      B2S(JE)=B2S(JE)+DF*(CNS*CS2+CNC*SN2)
   23 FQ(JE,JP)=FQH(JE)
      IF (GIMBAL .EQ. 0) GO TO 24
      CNS= .3509/MDB*FCMYH+2./FLOAT(MPSI)*CS*(DBETA-KPG*MP0/MDB*BETA)
      CNC=-.3509/MDB*FCMXH+2./FLOAT(MPSI)*SN*(DBETA-KPG*MP0/MDB*BETA)
      FBCH=FG(1,1)*CNS+FG(1,2)*CNC
      FBSH=FG(2,1)*CNS+FG(2,2)*CNC
      BGC=BGC+FBCH-FBC(JP)
      BGS=BGS+FBSH-FBS(JP)
      FBC(JP)=FBCH
      FBS(JP)=FBSH
   24 CT=CT+FCTH-FCT(JP)
      CQ=CQ+FCQH-FCQ(JP)
      CH=CH+FCHH-FCH(JP)
      CY=CY+FCYH-FCY(JP)
      CMX=CMX+FCMXH-FCMX(JP)
      CMY=CMY+FCMYH-FCMY(JP)
      FCT(JP)=FCTH
      FCQ(JP)=FCQH
      FCH(JP)=FCHH
      FCY(JP)=FCYH
      FCMX(JP)=FCMXH
      FCMY(JP)=FCMYH
    2 CONTINUE
      OUT=MAX0(0,2-JREV)
      DO 12 JE=NTRIM0,NTRIM1
      SUM=B0(JE)**2+.5*(B1C(JE)**2+B1S(JE)**2+B2C(JE)**2+B2S(JE)**2)
      IF (SUM .NE. 0.) SUM=SQRT(SUM)
      IF (ABS(SUM-SUMB(JE)) .GT. EPMODE) OUT=1
   12 SUMB(JE)=SUM
      SUM=.5*(BGC**2+BGS**2)
      IF (SUM .NE. 0.) SUM=SQRT(SUM)
      IF (ABS(SUM-SUMBG) .GT. EPMODE) OUT=1
      SUMBG=SUM
      IF (OUT .EQ. 0) GO TO 4
    1 CONTINUE
    4 CONTINUE
      CQ=CQ*FLOAT(ROTATE)
      CY=CY*FLOAT(ROTATE)
      CMX=CMX*FLOAT(ROTATE)
      RETURN
      END
      SUBROUTINE RTRIMP
      COMMON /RINPUT/TYPE,NBLADE,DEL3G,NTRIM0,NTRIM1,MU,LAMDA,MTIP,NBM,N-
     1TM,GIMBAL,GAMMA,OMEGA,RADIUS,SIGMA,OPAERO,MRAERO,BBLD,RROOT,INCOMP-
     2,T1C,T1S,T75,MPSI,MREV,OPMODE,OFFSET,MRMODE,NONROT,NCOLB,CONE,IB,D-
     3EL1,XFA,KPG,GGS,GQS(5),GPS(3),NCOLT,WT0,RFA,HSPRC,HSPRS,KPB(5),RPH-
     4,XPH,WTCH,WTSH,WTRH,WTC,WTS,WTR,NUGC,NUGS,KFLAP,KLAG,HINGE,KPIN,AT-
     5ANKP(5),DROOP,SWEEP,DEL2,DEL3,ZFA,VTIPN,DEBUGR,EPMODE,GLAG,LDAMP,E-
     6XDAMP,PHIPH,PHIPL,LDAMPC,MUY,MUZ,CHORD(51),XA(51),MASS(51),XI(51),-
     7THETA(51),ITHETA(51),TWIST(51),EIZZ(51),EIXX(51),GJ(51),XC(51),DEN-
     8SER,OPUNIR,ELAG,VTOT,KHLMDA,KFLMDA,ALFHP,PSIHP,T75IN,T1CIN,T1SIN,I-
     9RING,ROTATE,FDROOP,FSWEEP,DEL4,DEL5
      REAL MU,LAMDA,MTIP,IB,MASS,ITHETA,KPG,NUGC,NUGS,KPB,KFLAP,KLAG,LDA-
     1MP,LDAMPC,MUY,MUZ,KHLMDA,KFLMDA
      INTEGER OPAERO,GIMBAL,OPMODE,HINGE,DEBUGR,OPUNIR,ROTATE
      COMMON /ZTRIM/B0(5),B1C(5),B1S(5),B2C(5),B2S(5),BGC,BGS,CT,CH,CY,C-
     1MX,CMY,CQ,JREV,ALPHA(36,51),HHHT(505)
      REAL Q(5),CUNIT(2),MMAX
      DATA CUNIT/550.,746./
      DATA CVERT/57.29578/
  999 FORMAT (//1X,A4,' ROTOR TRIM')
  989 FORMAT (/5X,'BLADE MOTION ITERATIONS =',I4,10X,'(MAXIMUM =',I4,', -
     2 TOLERANCE =',F7.4,')')
  990 FORMAT (8X,'(VORTEX RING STATE)')
  991 FORMAT (/5X,'MU  =',F8.4,10X,'A-HP =',F8.2,20X,'T75 =',F9.2,10X,'(-
     1INPUT T75 =',F9.2,')'/5X,'MUY =',F8.4,10X,'P-HP =',F8.2,20X,'T1C =-
     2',F9.2,10X,'(INPUT T1C =',F9.2,')'/5X,'MUZ =',F8.4,10X,'MTIP =',F8-
     3.4,20X,'T1S =',F9.2,10X,'(INPUT T1S =',F9.2,')'/5X,'LAMBDA =',F8.4-
     4,7X,'MMAX =',F8.4)
  998 FORMAT(/10X,'BGC =',F9.2,10X,'BGS =',F9.2,5X,'(DEG)')
  997 FORMAT(/10X,'MODE',11X,'B0',18X,'B1C',17X,'B1S',17X,'B2C',17X,'B2S-
     1',5X,'(DEG)')
  996 FORMAT (12X,I1,F15.2,4F20.2)
  995 FORMAT (/5X,'ROTOR FORCES'/10X,'SHAFT AXES'/15X,                  -
     1   'THRUST',16X,'CT =',F11.7,5X,'CT/S =',F10.6,8X,'T =',F10.0/15X,-
     2'DRAG FORCE',12X,'CH =',F11.7,5X,'CH/S =',F10.6,8X,'H =',F10.0/15X-
     3,'SIDE FORCE',12X,'CY =',F11.7,5X,'CY/S =',F10.6,8X,'Y =',F10.0/15-
     4X,'ROLL MOMENT',11X,'CMX=',F11.7,5X,'CMX/S=',F10.6,8X,'MX=',F10.0/-
     515X,'PITCH MOMENT',10X,'CMY=',F11.7,5X,'CMY/S=',F10.6,8X,'MY=',F10-
     6.0/15X,'TORQUE',16X,'CQ =',F11.7,5X,'CQ/S =',F10.6,8X,'Q =',F10.0/-
     715X,'POWER',17X,'CP =',F11.7,5X,'CP/S =',F10.6,8X,'P =',F10.0/    -
     810X,'WIND AXES'/                                                  -
     915X,'LIFT',18X,'CL =',F11.7,5X,'CL/S =',F10.6,8X,'L =',F10.0/15X,'-
     APROPULSIVE FORCE',6X,'CX =',F11.7,5X,'CX/S =',F10.6,8X,'PF=',F10.0-
     B)
  994 FORMAT (/10X,'ROTOR POWER (HP)  =',F10.2,11X,'(INDUCED/PROFILE/PAR-
     1ASITE+CLIMB SPLIT  =  ',F8.2,'/',F8.2,'/',F8.2,')')
  981 FORMAT (10X,'ROTOR FIGURE OF MERIT  M =',F8.4)
  980 FORMAT (                                10X,'ROTOR EQUIVALENT DRAG-
     1  D = P/V-PF =',F8.0/10X,'ROTOR LIFT-DRAG RATIO  L/D =',F8.3/10X,'-
     2ROTOR EQUIVALENT DRAG AREA  F = D/Q =',F8.2)
  993 FORMAT ( /5X,'ANGLE OF ATTACK')
  992 FORMAT (5X,'PSI=',F4.0,4X,21F5.1/47X,15F5.1/47X,15F5.1)
      PRINT 999, TYPE
      T75OUT=.5*(THETA(38)+THETA(39))*CVERT
      T1SOUT=T1S*CVERT
      T1COUT=T1C*CVERT
      MMAX=MU**2+MUY**2
      IF (MMAX .GT. 0.) MMAX=SQRT(MMAX)
      MMAX=MTIP*SQRT(1.+LAMDA**2+MMAX**2+2.*MMAX)
      PRINT 991, MU,ALFHP,T75OUT,T75IN,MUY,PSIHP,T1COUT,T1CIN,MUZ,MTIP,T-
     11SOUT,T1SIN,LAMDA,MMAX
      IF (IRING .NE. 0) PRINT 990
      PRINT 989, JREV,MREV,EPMODE
      FBCH=BGC*CVERT
      FBSH=BGS*CVERT
      IF (GIMBAL .NE. 0) PRINT 998, FBCH,FBSH
      PRINT 997
      DO 10 JE=1,NTRIM1
      Q(1)=B0(JE)*CVERT
      Q(2)=B1C(JE)*CVERT
      Q(3)=B1S(JE)*CVERT
      Q(4)=B2C(JE)*CVERT
      Q(5)=B2S(JE)*CVERT
   10 PRINT 996, JE,(Q(I), I=1,5)
      CTH=CT*SIGMA
      CHH=CH*SIGMA
      CYH=CY*SIGMA
      CMXH=CMX*SIGMA
      CMYH=CMY*SIGMA
      CQH=CQ*SIGMA
      CNST=GAMMA*IB*FLOAT(NBLADE)/5.7*OMEGA**2/RADIUS*DENSER
      FT=CT*CNST
      FH=CH*CNST
      FY=CY*CNST
      FMX=CMX*CNST*RADIUS
      FMY=CMY*CNST*RADIUS
      FQ=CQ*CNST*RADIUS
      CP=CQ*FLOAT(ROTATE)
      CPH=CQH*FLOAT(ROTATE)
      FP=FQ*OMEGA*FLOAT(ROTATE)
      FHP=FP/CUNIT(OPUNIR)
      VEL=MU**2+MUY**2+MUZ**2
      FPF=0.
      RDRAG=0.
      RLOD=0.
      ADRAG=0.
      FL=SQRT(FT**2+FH**2+FY**2)
      IF (VEL .EQ. 0.) GO TO 11
      VEL=SQRT(VEL)
      FPF=(-MU*FH+MUY*FY+MUZ*FT)/VEL
      FL=FL**2-FPF**2
      IF (FL .GT. 0.) FL=SQRT(FL)
      RDRAG=FP/(VEL*OMEGA*RADIUS)-FPF
      IF (RDRAG .NE. 0.) RLOD=FL/RDRAG
      ADRAG=RDRAG*SIGMA*6.283185*RADIUS**2/VEL**2/CNST
   11 CPF=FPF/CNST
      CL=FL/CNST
      CPFH=CPF*SIGMA
      CLH=CL*SIGMA
      FHPI=(LAMDA-MUZ)*OMEGA*RADIUS*FT/CUNIT(OPUNIR)
      FHPP=VEL*OMEGA*RADIUS*FPF/CUNIT(OPUNIR)
      FHPO=FHP-FHPI-FHPP
      FMERIT=ABS(CTH/CPH*(.5*MUZ+SQRT(ABS(.25*MUZ*MUZ+.5*CTH))))
      PRINT 995, CTH,CT,FT,CHH,CH,FH,CYH,CY,FY,CMXH,CMX,FMX,CMYH,CMY,FMY-
     1,CQH,CQ,FQ,CPH,CP,FP,CLH,CL,FL,CPFH,CPF,FPF
      PRINT 994, FHP,FHPI,FHPO,FHPP
      IF (VTOT .LE. .001) PRINT 981, FMERIT
      IF (VTOT .GT. .001) PRINT 980, RDRAG,RLOD,ADRAG
      PRINT 993
      MR1=MRAERO+1
      MPSIP=MPSI
      IF (VTOT .LE. .001) MPSIP=1
      DPSI=360./FLOAT(MPSIP)
      DO 12 JP=1,MPSIP
      PSI=FLOAT(JP)*DPSI
   12 PRINT 992, PSI,(ALPHA(JP,JR), JR=1,MR1)
      RETURN
      END
      SUBROUTINE INERT(PSI)
      COMMON /RINPUT/TYPE,NBLADE,DEL3G,NTRIM0,NTRIM1,MU,LAMDA,MTIP,NBM,N-
     1TM,GIMBAL,GAMMA,OMEGA,RADIUS,SIGMA,OPAERO,MRAERO,BBLD,RROOT,INCOMP-
     2,T1C,T1S,T75,MPSI,MREV,OPMODE,OFFSET,MRMODE,NONROT,NCOLB,CONE,IB,D-
     3EL1,XFA,KPG,GGS,GQS(5),GPS(3),NCOLT,WT0,RFA,HSPRC,HSPRS,KPB(5),RPH-
     4,XPH,WTCH,WTSH,WTRH,WTC,WTS,WTR,NUGC,NUGS,KFLAP,KLAG,HINGE,KPIN,AT-
     5ANKP(5),DROOP,SWEEP,DEL2,DEL3,ZFA,VTIPN,DEBUGR,EPMODE,GLAG,LDAMP,E-
     6XDAMP,PHIPH,PHIPL,LDAMPC,MUY,MUZ,CHORD(51),XA(51),MASS(51),XI(51),-
     7THETA(51),ITHETA(51),TWIST(51),EIZZ(51),EIXX(51),GJ(51),XC(51),DEN-
     8SER,OPUNIR,ELAG,VTOT,KHLMDA,KFLMDA,ALFHP,PSIHP,T75IN,T1CIN,T1SIN,I-
     9RING,ROTATE,FDROOP,FSWEEP,DEL4,DEL5
      REAL MU,LAMDA,MTIP,IB,MASS,ITHETA,KPG,NUGC,NUGS,KPB,KFLAP,KLAG,LDA-
     1MP,LDAMPC,MUY,MUZ,KHLMDA,KFLMDA
      INTEGER OPAERO,GIMBAL,OPMODE,HINGE,DEBUGR,OPUNIR,ROTATE
      COMMON /MODES/ETA(5,2,51),ETAP(5,2,51),ETAPP(5,2,51),NU(5),ZETA(3,-
     151),ZETAP(3,51),WT(3),EFA(5,2),EFAP(5,2),EFAPP(5,2)
      REAL NU
      COMMON /ZTRIM/B0(5),B1C(5),B1S(5),B2C(5),B2S(5),BGC,BGS,HHHT(2348)
      COMMON /BINERT/   I0,SQ(5,2),IQA(5,2),SPA(3,2),IDQA(5),IDQP(5),IQ(-
     15),SQDDP(5,3),SQP(5,3),IQDQ(5,5),IP(3),SP(3,2),IPA(3,2),SPDDA(3),S-
     2PDDQ(3,5),SPQ(3,5),IPDDP(3,3),IPP(3,3),XATOR(3,2,51),DXATOR(3,5,2,-
     351),MASSB,IQDP(5),IDQA0
      REAL MASSB,I0,IQA,IDQA,IDQP,IQ,IQDQ,IP,IPA,IPDDP,IPP,IQDP,IDQA0
      NAMELIST /NLDB/I0,SQ,IQA,SPA,IDQA,IDQP,IQ,SQDDP,SQP,IQDQ,IP,SP,IPA-
     1,SPDDA,SPDDQ,SPQ,IPDDP,IPP,MASSB,IQDP,IDQA0
      DIMENSION ZERO(2006)
      EQUIVALENCE (ZERO(1),I0)
      DIMENSION Z0(2,51),Z0P(2,51),Z0PP(2,51),Z0I(2,51),Z0FA(2),Z0FAP(2)
      REAL M1,IT1,M2
      DIMENSION C1(5,51),C2(5,2,51),XTOR(3,2,51),C5(51),C6(51),C7(51),C8-
     1(51),C9(51),C3(5,51),C4(5,51),C10(5,51),DEL(2),XIC(51),QTRIM(5)
      IF (DEBUGR .EQ. 0) GO TO 78
      DO 79 I=1,2006
   79 ZERO(I)=0.
   78 CONTINUE
      DO 71 I=NTRIM0,NTRIM1
   71 QTRIM(I)=B0(I)
      BETA=0.
      TETA=0.
   72 DO 74 JR=1,51
      DO 75 I=1,2
      Z0(I,JR)=0.
      Z0P(I,JR)=0.
      Z0PP(I,JR)=0.
      DO 75 JE=NTRIM0,NTRIM1
      Z0(I,JR)=Z0(I,JR)+QTRIM(JE)*ETA(JE,I,JR)
      Z0P(I,JR)=Z0P(I,JR)+QTRIM(JE)*ETAP(JE,I,JR)
   75 Z0PP(I,JR)=Z0PP(I,JR)+QTRIM(JE)*ETAPP(JE,I,JR)
      T=THETA(JR)
      Z0I(1,JR)=Z0(1,JR)-XI(JR)*SIN(T)
   74 Z0I(2,JR)=Z0(2,JR)-XI(JR)*COS(T)
      DO 76 I=1,2
      Z0FA(I)=0.
      Z0FAP(I)=0.
      DO 76 JE=NTRIM0,NTRIM1
      Z0FA(I)=Z0FA(I)+QTRIM(JE)*EFA(JE,I)
   76 Z0FAP(I)=Z0FAP(I)+QTRIM(JE)*EFAP(JE,I)
      IRFA=IFIX(RFA*50.+.5)+1
      DEL(1)=DEL2-DEL4
      DEL(2)=DEL3-DEL5
      XFB=XFA+RFA*DEL3+ZFA*TETA
      DLT1=DEL1+BETA
      DLT2=DEL2-DEL4
      DLT3=DEL3-DEL5
      DO 13 I=1,NBM
      C1(I,1)=0.
      D1=ETAPP(I,1,1)*Z0I(1,1)+ETAPP(I,2,1)*Z0I(2,1)
      DO 12 JR=2,51
      D2=ETAPP(I,1,JR)*Z0I(1,JR)+ETAPP(I,2,JR)*Z0I(2,JR)
      C1(I,JR)=C1(I,JR-1)+.01*(D1+D2)
   12 D1=D2
      DO 13 JR=1,51
   13 C1(I,JR)=ETAP(I,1,JR)*Z0I(1,JR)+ETAP(I,2,JR)*Z0I(2,JR)-C1(I,JR)
      DO 15 I=1,NTM
      DO 15 J=1,2
      C2(I,J,1)=0.
      XTOR(I,J,1)=0.
      Z1=ZETAP(I,1)
      R1=0.
      DO 15 JR=2,51
      IF  (I .EQ. 1) GO TO 16
      Z2=ZETAP(I,JR)
      R2=FLOAT(JR-1)*.02
      C2(I,J,JR)=C2(I,J,JR-1)+.01*(Z2*Z0P(J,JR)+Z1*Z0P(J,JR-1))
      XTOR(I,J,JR)=XTOR(I,J,JR-1)+.01*(Z2*(Z0(J,JR)-R2*Z0P(J,JR))+Z1*(Z0-
     1(J,JR-1)-R1*Z0P(J,JR-1)))
      Z1=Z2
      R1=R2
      GO TO 15
   16 C2(I,J,JR)=0.
      XTOR(I,J,JR)=0.
   15 CONTINUE
      DO 17 I=1,NTM
      DO 17 J=1,2
      DO 17 JR=1,51
      R=FLOAT(JR-1)*.02
      XTOR(I,J,JR)=XTOR(I,J,JR)+R*C2(I,J,JR)
      IF ((I .EQ. 1) .AND. (R .GE. RFA)) XTOR(I,J,JR)=Z0FA(J)+Z0FAP(J)  -
     1    *(R-RFA)+DEL(J)*(R-RFA)
      XATOR(I,J,JR)=XTOR(I,J,JR)-ZETA(I,JR)*Z0(J,JR)
   17 XTOR(I,J,JR)=XTOR(I,J,JR)-ZETA(I,JR)*Z0I(J,JR)
      DO 62 JR=1,51
      R=FLOAT(JR-1)*.02
      DO 62 I =1,NBM
      DO 62 IT=1,NTM
      DO 62 J=1,2
      IF (IT .GT. 1) GO TO 64
      DXATOR(IT,I,J,JR)=-ETA(I,J,JR)+EFA(I,J)+EFAP(I,J)*(R-RFA)
      IF (R .LT. RFA) DXATOR(IT,I,J,JR)=0.
      GO TO 62
   64 CONTINUE
      DXATOR(IT,I ,J,JR)=-ETA(I ,J,JR)*ZETA(IT,JR)
      DO 63 JRHO=1,JR
      RHO=FLOAT(JRHO-1)*.02
      H=.02
      IF ((JRHO .EQ. 1) .OR. (JRHO .EQ. JR)) H=.01
   63 DXATOR(IT,I ,J,JR)=DXATOR(IT,I ,J,JR)+H*ZETAP(IT,JRHO)*(ETA(I ,J,J-
     1RHO)+(R-RHO)*ETAP(I ,J,JRHO))
   62 CONTINUE
      DO 65 JR=1,51
   65 XIC(JR)=XI(JR)-XC(JR)
      DO 21 I=1,NBM
      DO 21 J=1,2
   21 C2(I,J,51)=0.
      C5(51)=0.
      C6(51)=0.
      C7(51)=0.
      C8(51)=0.
      C9(51)=0.
      M2=MASS(51)
      R2=1.
      DO 22 JR1=2,51
      JR=52-JR1
      M1=MASS(JR)
      R1=FLOAT(JR-1)*.02
      C5(JR)=C5(JR+1)+.01*(R1*M1+R2*M2)
      C8(JR)=C8(JR+1)+.01*(R1*R1*M1+R2*R2*M2)
      C9(JR)=C9(JR+1)+.01*(M1+M2)
      C6(JR)=C6(JR+1)-.01*(M1*Z0I(2,JR)+M2*Z0I(2,JR+1))
      C7(JR)=C7(JR+1)+.01*(M1*R1*Z0I(1,JR)+M2*R2*Z0I(1,JR+1))
      DO 23 I=1,NBM
      DO 23 J=1,2
   23 C2(I,J,JR)=C2(I,J,JR+1)+.01*(M1*ETA(I,J,JR)+M2*ETA(I,J,JR+1))
      M2=M1
   22 R2=R1
      DO 24 JR=1,51
      R=FLOAT(JR-1)*.02
      C6(JR)=C6(JR)*R+Z0(2,JR)*C5(JR)+(XFB         )*(C5(JR)-R*C9(JR))
      C7(JR)=C7(JR)-Z0(1,JR)*C5(JR)+(DLT1-DEL2)*(C8(JR)-R*C5(JR))
      M1=MASS(JR)
      DO 24 I=1,NBM
      C3(I,JR)=-Z0PP(2,JR)*(R*C2(I,1,JR)-ETA(I,1,JR)*C5(JR))+Z0PP(1,JR)*-
     1(R*C2(I,2,JR)-ETA(I,2,JR)*C5(JR))
      EI=R*M1*ETAP(I,1,JR)-ETAPP(I,1,JR)*C5(JR)
      EK=R*M1*ETAP(I,2,JR)-ETAPP(I,2,JR)*C5(JR)
      C4(I,JR)=Z0I(1,JR)*EI+Z0I(2,JR)*EK
   24 C10(I,JR)=-Z0I(2,JR)*EI+Z0I(1,JR)*EK
      MASSB=0.
      I0=0.
      IDQA0=0.
      DO 31 K=1,NBM
      IQ(K)=0.
      IDQA(K)=0.
      IQDP(K)=0.
      IDQP(K)=0.
      DO 32 I=1,2
      SQ(K,I)=0.
   32 IQA(K,I)=0.
      DO 33 I=1,NTM
      SQDDP(K,I)=0.
      SQP(K,I)=0.
      SPDDQ(I,K)=0.
   33 SPQ(I,K)=0.
      DO 31 I=1,NBM
   31 IQDQ(K,I)=0.
      DO 34 K=1,NTM
      IP(K)=0.
      SPDDA(K)=0.
      DO 35 I=1,2
      SPA(K,I)=0.
      SP(K,I)=0.
   35 IPA(K,I)=0.
      DO 34 I=1,NTM
      IPDDP(K,I)=0.
   34 IPP(K,I)=0.
      DO 40 JR=1,51
      H=.02*RADIUS**3/IB
      IF ((JR .EQ. 1) .OR. (JR .EQ. 51)) H=.5*H
      R=FLOAT(JR-1)*.02
      RMRFA=AMAX1(0.,R-RFA)
      M1=MASS(JR)
      IT1=ITHETA(JR)/RADIUS**2
      CS=COS(THETA(JR))
      SN=SIN(THETA(JR))
      MASSB=MASSB+H*M1
      I0=I0+H*R*R*M1
      IDQA0=IDQA0+H*R*M1*(DLT1*R+Z0I(1,JR)-ZFA-DEL2*RMRFA)
      DO 41 K=1,NBM
      EI=ETA(K,1,JR)
      EK=ETA(K,2,JR)
      EIZ=EFA(K,1)
      EKZ=EFA(K,2)
      IQ(K)=IQ(K)+H*M1*(EI*EI+EK*EK)
      IDQA(K)=IDQA(K)+H*EK*M1*(DLT1*R+Z0I(1,JR)-ZFA-DEL2*RMRFA)
      IDQP(K)=IDQP(K)+H*(C4(K,JR)+M1*(DLT1*EI*R-EK*(XFB+Z0I(2,JR))-EI*DE-
     1L2*RMRFA))
      IQDP(K)=IQDP(K)+H*(C4(K,JR)+M1*((DLT1-DEL2)*EI*R-EK*(XFB+Z0I(2,JR)-
     1))-C5(JR)*XIC(JR)*(ETAPP(K,1,JR)*SN+ETAPP(K,2,JR)*CS))
      IF (JR .EQ. 1) IQDP(K)=IQDP(K)-RADIUS**3/IB*(C5(JR)*XIC(JR)*(ETAP(-
     1K,1,JR)*SN+ETAP(K,2,JR)*CS)-C5(IRFA)*(DEL2*EIZ+DEL3*EKZ))
      IF (JR .EQ. 51) IQDP(K)=IQDP(K)+RADIUS**3/IB*M1*XIC(JR)*(EI*SN+EK*-
     1CS)
      DO 42 J=1,2
      SQ(K,J)=SQ(K,J)+H*ETA(K,J,JR)*M1
   42 IQA(K,J)=IQA(K,J)+H*ETA(K,J,JR)*M1*R
      DO 43 I=1,NTM
      Z=ZETA(I,JR)
      ZZ=ZETA(I,IRFA)
      IF (R .LT. RFA) ZZ=0.
      SQDDP(K,I)=SQDDP(K,I)+H*M1*Z*(EK*Z0I(1,JR)-EI*Z0I(2,JR))+H*ZZ*M1*R-
     1MRFA*(DLT3*EI-DLT2*EK)
      SQP(K,I)=SQP(K,I)+H*Z*(C10(K,JR)-M1*EK*Z0I(1,JR)+M1*R*XIC(JR)*(ETA-
     1P(K,1,JR)*CS-ETAP(K,2,JR)*SN))+H*ZZ*M1*(DLT3*R*(EI-EIZ)+DLT2*(R*EK-
     2Z-RFA*EK))+H*Z*XIC(JR)*((ETAPP(K,1,JR)*CS-ETAPP(K,2,JR)*SN)*C5(JR)-
     3-(ETAP(K,1,JR)*CS-ETAP(K,2,JR)*SN)*R*M1)
      IF (JR .EQ. IRFA) SQP(K,I)=SQP(K,I)+C5(IRFA)*RADIUS**3/IB*XIC(IRFA-
     1)*ZZ*(EFAP(K,1)*CS-EFAP(K,2)*SN)
      IF (JR .EQ. 51) SQP(K,I)=SQP(K,I)-M1*RADIUS**3/IB*XIC(JR)*(EI*CS-E-
     1K*SN)
      SPDDQ(I,K)=SPDDQ(I,K)+H*M1*(EI*XTOR(I,2,JR)-EK*XTOR(I,1,JR))
      IF (I .EQ. 1) GO TO 43
      SPQ(I,K)=SPQ(I,K)+H*(M1*EI*XTOR(I,2,JR)+Z*XI(JR)*M1*(CS*(ETAP(K,1,-
     1JR)*R-ETA(K,1,JR))-SN*(ETAP(K,2,JR)*R-ETA(K,2,JR)))+Z*(C3(K,JR)-ET-
     2APP(K,1,JR)*C6(JR)-ETAPP(K,2,JR)*C7(JR)))
   43 CONTINUE
      IF (R .LT. RFA) GO TO 46
      SPQ(1,K)=SPQ(1,K)+H*M1*(EI*XTOR(1,2,JR)-(EI-R*EFAP(K,1))*(XFB-RFA*-
     1DLT3+Z0FA(2)-RFA*Z0FAP(2))-(EK-R*EFAP(K,2))*(R*(DLT1-DEL2)+RFA*DLT-
     22+Z0I(1,JR)-Z0FA(1)+RFA*Z0FAP(1))+(EFA(K,1)-RFA*EFAP(K,1))*(XFB+R*-
     3DEL5+Z0I(2,JR)-R*Z0FAP(2))+(EFA(K,2)-RFA*EFAP(K,2))*(R*(DLT1-DEL2--
     4DEL4)+R*Z0FAP(1)))
   46 IF (JR .EQ. 1) SPQ(1,K)=SPQ(1,K)+RADIUS**3/IB*C5(IRFA)*(EFAP(K,1)*-
     1DEL3-EFAP(K,2)*DEL2)*RFA
      DO 41 I=1,NBM
      IF (JR .EQ. 1) IQDQ(K,I)=IQDQ(K,I)-RADIUS**3/IB*(C2(I,2,JR)*XIC(JR-
     1)*(ETAP(K,1,JR)*SN+ETAP(K,2,JR)*CS)-C2(I,2,IRFA)*(DEL2*EIZ+DEL3*EK-
     2Z))
      IF (JR .EQ. 51) IQDQ(K,I)=IQDQ(K,I)+RADIUS**3/IB*M1*XIC(JR)*ETA(I,-
     12,JR)*(EI*SN+EK*CS)
   41 IQDQ(K,I)=IQDQ(K,I)+H*M1*(-EK*C1(I,JR)+ETA(I,2,JR)*(C1(K,JR)+(DEL1-
     1-DEL2)*EI)-(DLT1-DEL2)*EK*ETA(I,1,JR))-H*C2(I,2,JR)*XIC(JR)*(ETAPP-
     2(K,1,JR)*SN+ETAPP(K,2,JR)*CS)
      DO 44 K=1,NTM
      Z=ZETA(K,JR)
      ZZ=ZETA(K,IRFA)
      IP(K)=IP(K)+H*Z*Z*IT1
      SPDDA(K)=SPDDA(K)+H*M1*XTOR(K,1,JR)*(DLT1*R+Z0I(1,JR)-ZFA-DEL2*RMR-
     1FA)
      SPA(K,1)=SPA(K,1)-H*Z*Z0I(2,JR)*R*M1+H*ZZ*DLT3*R*RMRFA*M1
      SPA(K,2)=SPA(K,2)+H*Z*Z0I(1,JR)*R*M1-H*ZZ*DLT2*R*RMRFA*M1
      DO 45 J=1,2
      SP(K,J)=SP(K,J)+H*M1*XTOR(K,J,JR)
   45 IPA(K,J)=IPA(K,J)+H*M1*XTOR(K,J,JR)*R
      DO 44 I=1,NTM
      ZI=ZETA(I,JR)
      ZZI=ZETA(I,IRFA)
      IPDDP(K,I)=IPDDP(K,I)+H*(-M1*ZI*(XTOR(K,1,JR)*Z0I(1,JR)+XTOR(K,2,J-
     1R)*Z0I(2,JR)+Z*XI(JR)**2)+IT1*((Z-ZZ)*ZZI+(ZI-ZZI)*ZZ)+ZZI*M1*RMRF-
     2A*(DLT2*XTOR(K,1,JR)+DLT3*XTOR(K,2,JR)))
   44 IPP(K,I)=IPP(K,I)+H*(Z*ZI*IT1*(CS*CS-SN*SN)+ZETAP(K,JR)*ZETAP(I,JR-
     1)*IT1/M1*C5(JR))
   40 CONTINUE
      IF (DEBUGR .NE. 0) WRITE(6,NLDB)
      RETURN
      END
      SUBROUTINE DERED(NX,NV,NG,DOF,CON,GUST,A2,A1,A0,B,BG,DOF1,DOF0)
      INTEGER DOF(1),CON(1),GUST(1),DOF1(1),DOF0(1)
      DIMENSION A2(1),A1(1),A0(1),B(1),BG(1)
      MX=0
      DO 61 I=1,NX
   61 MX=MX+DOF(I)
      JCOL=0
      DO 71 I=1,NX
      IF (DOF(I) .EQ. 0) GO TO 71
      JCOL=JCOL+1
      JROW=0
      DOF1(JCOL)=DOF1(I)
      DOF0(JCOL)=DOF0(I)
      DO 72 K=1,NX
      IF (DOF(K) .EQ. 0) GO TO 72
      JROW=JROW+1
      JA=(I-1)*NX+K
      JA1=(JCOL-1)*MX+JROW
      A2(JA1)=A2(JA)
      A1(JA1)=A1(JA)
      A0(JA1)=A0(JA)
   72 CONTINUE
   71 CONTINUE
      JCOL=0
      DO 73 I=1,NV
      IF (CON(I) .EQ. 0) GO TO 73
      JCOL=JCOL+1
      JROW=0
      DO 74 K=1,NX
      IF (DOF(K) .EQ. 0) GO TO 74
      JROW=JROW+1
      JB=(I-1)*NX+K
      JB1=(JCOL-1)*MX+JROW
      B(JB1)=B(JB)
   74 CONTINUE
   73 CONTINUE
      JCOL=0
      DO 75 I=1,NG
      IF (GUST(I) .EQ. 0) GO TO 75
      JCOL=JCOL+1
      JROW=0
      DO 76 K=1,NX
      IF (DOF(K) .EQ. 0) GO TO 76
      JROW=JROW+1
      JB=(I-1)*NX+K
      JB1=(JCOL-1)*MX+JROW
      BG(JB1)=BG(JB)
   76 CONTINUE
   75 CONTINUE
      RETURN
      END
      SUBROUTINE QSTRAN(MX,MX0,MX1,MV,A2,A1,A0,B0,DOF1,DOF0)
      DIMENSION A2(1),A1(1),A0(1),B0(1)
      INTEGER DOF1(1),DOF0(1)
      COMMON /WORK/AH(3600),BH(3600),CH(3600),DH(3600)
      INTEGER ORD(60),LH(61),MH(61)
C  MAXIMUM MX=60, MV=60
      IF (MX0 .LE. 0) RETURN
      MXM0=MX-MX0
      MXSQ=MX*MX
      MVX=MX*MV
      JX1=0
      JX2=MXM0
      DO 11 JX=1,MX
      IF (DOF0(JX) .EQ. 0) GO TO 12
      JX1=JX1+1
      JXX=JX1
      GO TO 11
   12 JX2=JX2+1
      JXX=JX2
   11 ORD(JX)=JXX
      DO 13 JX=1,MX
      DO 13 JXX=1,MX
      JA1=(JX-1)*MX+JXX
      JA2=(ORD(JX)-1)*MX+ORD(JXX)
      AH(JA2)=A2(JA1)
      BH(JA2)=A1(JA1)
   13 CH(JA2)=A0(JA1)
      DO 14 JX=1,MXSQ
      A2(JX)=AH(JX)
      A1(JX)=BH(JX)
   14 A0(JX)=CH(JX)
      DO 15 JX=1,MX
      JX1=ORD(JX)
   15 LH(JX1)=DOF1(JX)
      DO 16 JX=1,MX
   16 DOF1(JX)=LH(JX)
      DO 111 JX=1,MX0
      JX1=MXM0+JX
      IF (DOF1(JX1) .NE. 0) GO TO 111
      DO 112 JXX=1,MX
      JX2=(JX1-1)*MX+JXX
  112 A0(JX2)=A1(JX2)
  111 CONTINUE
      IF (MV .LE. 0) GO TO 19
      DO 17 JX=1,MX
      DO 17 JV=1,MV
      JA1=(JV-1)*MX+JX
      JA2=(JV-1)*MX+ORD(JX)
   17 AH(JA2)=B0(JA1)
      DO 18 JX=1,MVX
   18 B0(JX)=AH(JX)
   19 DO 21 JX=1,MX0
      DO 21 JXX=1,MX0
      JX1=(JX-1)*MX0+JXX
      JX2=(JX+MXM0-1)*MX+JXX+MXM0
   21 AH(JX1)=A0(JX2)
      CALL MINV(AH,MX0,DET,LH,MH)
      DO 22 JX=1,MXM0
      DO 22 JXX=1,MX0
      JB=(JXX-1)*MXM0+JX
      BH(JB)=0.
      DO 22 JI=1,MX0
      JA1=(JXX-1)*MX0+JI
      JA2=(JI+MXM0-1)*MX+JX
   22 BH(JB)=BH(JB)+A0(JA2)*AH(JA1)
      DO 23 JX=1,MXM0
      DO 23 JXX=1,MXM0
      JA=(JXX-1)*MX+JX
      DO 23 JI=1,MX0                                                    -
     JA1=(JXX-1)*MX+JI+MXM0
      JA2=(JI-1)*MXM0+JX
      A2(JA)=A2(JA)-BH(JA2)*A2(JA1)
      A1(JA)=A1(JA)-BH(JA2)*A1(JA1)
   23 A0(JA)=A0(JA)-BH(JA2)*A0(JA1)
      IF (MV .LE. 0) GO TO 24
      DO 25 JX=1,MXM0
      DO 25 JV=1,MV
      JB=(JV-1)*MX+JX
      DO 25 JI=1,MX0
      JA1=(JV-1)*MX+JI+MXM0
      JA2=(JI-1)*MXM0+JX
   25 B0(JB)=B0(JB)-BH(JA2)*B0(JA1)
   24 DO 31 JX=1,MXM0
      DO 31 JXX=1,MXM0
      JX1=(JX-1)*MXM0+JXX
      JX2=(JX-1)*MX+JXX
      A2(JX1)=A2(JX2)
      A1(JX1)=A1(JX2)
   31 A0(JX1)=A0(JX2)
      IF (MV .LE. 0) GO TO 32
      DO 33 JV=1,MV
      DO 33 JXX=1,MXM0
      JX1=(JV-1)*MXM0+JXX
      JX2=(JV-1)*MX+JXX
   33 B0(JX1)=B0(JX2)
   32 MX=MX-MX0
      MX1=0
      DO 34 JX=1,MX
      IF (DOF1(JX) .EQ. 0) MX1=MX1+1
   34 CONTINUE
      RETURN
      END
      SUBROUTINE MINV(A,N,D,L,M)
      DIMENSION L(1),M(1),A(1)
      D=1.0
      NK=-N
      DO 80 K=1,N
      NK=NK+N
      L(K)=K
      M(K)=K
      KK=NK+K
      BIGA=A(KK)
      DO 20 J=K,N
      IZ=N*(J-1)
      DO 20 I=K,N
      IJ=IZ+I
   10 IF (ABS(BIGA)-ABS(A(IJ)))15,20,20
   15 BIGA=A(IJ)
      L(K)=I
      M(K)=J
   20 CONTINUE
      J=L(K)
      IF (J-K) 35,35,25
   25 KI=K-N
      DO 30 I=1,N
      KI=KI+N
      HOLD=-A(KI)
      JI=KI-K+J
      A(KI)=A(JI)
   30 A(JI)=HOLD
   35 I=M(K)
      IF (I-K) 45,45,38
   38 JP=N*(I-1)
      DO 40 J=1,N
      JK=NK+J
      JI=JP+J
      HOLD=-A(JK)
      A(JK)=A(JI)
   40 A(JI)=HOLD
   45 IF(BIGA)48,46,48
   46 D=0.0
      RETURN
   48 DO 55 I=1,N
      IF (I-K) 50,55,50
   50 IK=NK+I
      A(IK)=A(IK)/(-BIGA)
   55 CONTINUE
      DO 65 I=1,N
      IK=NK+I
      HOLD=A(IK)
      IJ=I-N
      DO 65 J=1,N
      IJ=IJ+N
      IF (I-K) 60,65,60
   60 IF (J-K) 62,65,62
   62 KJ=IJ-I+K
      A(IJ)=HOLD*A(KJ)+A(IJ)
   65 CONTINUE
      KJ=K-N
      DO 75 J=1,N
      KJ=KJ+N
      IF (J-K) 70,75,70
   70 A(KJ)=A(KJ)/BIGA
   75 CONTINUE
      D=D*BIGA
      A(KK)=1.0/BIGA
   80 CONTINUE
      K=N
  100 K=K-1
      IF (K) 150,150,105
  105 I=L(K)
      IF (I-K) 120,120,108
  108 JQ=N*(K-1)
      JR=N*(I-1)
      DO 110 J=1,N
      JK=JQ+J
      HOLD=A(JK)
      JI=JR+J
      A(JK)=-A(JI)
  110 A(JI)=HOLD
  120 J=M(K)
      IF (J-K) 100,100,125
  125 KI=K-N
      DO 130 I=1,N
      KI=KI+N
      HOLD=A(KI)
      JI=KI-K+J
      A(KI)=-A(JI)
  130 A(JI)=HOLD
      GO TO 100
  150 RETURN
      END
      SUBROUTINE TRANS(B0,MX,MX1,MV,RESPON,NF,DOFP,CONP)
      DIMENSION B0(1)
      INTEGER DOFP(1),CONP(1),RESPON
      COMMON /WORK/AH(3600),BH(3600),CH(3600),A(3600)
      DIMENSION HM(151),HP(151),LMINV(101),MMINV(101)
      EQUIVALENCE (HM(1),CH(1001)),(HP(1),CH(1152)),(LMINV(1),CH(1303)),-
     1(MMINV(1),CH(1404))
      INTEGER OPTION
      REAL MAG
      NF=MIN0(151,NF)
      MX2=2*MX-MX1
      MX2SQ=MX2*MX2
      DO 10 JX=1,MX2
      DO 10 JXX=1,MX2
      JA=(JX-1)*MX2+JXX
      AH(JA)=0.
      DO 10 JI=1,MX2
      JA1=(JX-1)*MX2+JI
      JA2=(JI-1)*MX2+JXX
   10 AH(JA)=AH(JA)+A(JA1)*A(JA2)
      DO 20 JV=1,MV
      DO 20 JX1=1,MX
      IF (CONP(JV) .EQ. 0) GO TO 20
      IF (DOFP(JX1).EQ. 0) GO TO 20
      JX=MX-MX1+JX1
      DO 21 JF=1,NF
      F=-2.+3.*FLOAT(JF-1)/FLOAT(NF-1)
      W=10.**F
      DO 22 JXX=1,MX2SQ
   22 BH(JXX)=AH(JXX)
      DO 23 JXX=1,MX2
      JA=(JXX-1)*MX2+JXX
   23 BH(JA)=BH(JA)+W*W
      CALL MINV(BH,MX2,DET,LMINV,MMINV)
      DO 24 JXX=1,MX2
      CH(JXX)=0.
      DO 24 JI=1,MX
      JB=(JV-1)*MX+JI
      JA=(JI-1)*MX2+JXX
   24 CH(JXX)=CH(JXX)+BH(JA)*B0(JB)
      RE=0.
      DO 25 JI=1,MX2
      JA=(JI-1)*MX2+JX
   25 RE=RE-A(JA)*CH(JI)
      AI=-W*CH(JX)
      MAG=0.
      PHS=0.
      IF ((RE .EQ. 0.) .AND. (AI .EQ. 0.)) GO TO 26
      MAG=SQRT(RE*RE+AI*AI)
      PHS=57.29578*ATAN2(AI,RE)
      IF (PHS .GE. 180.) PHS=179.999
      IF (PHS .LE.-180.) PHS=-179.999
   26 HM(JF)=MAG
      HP(JF)=PHS
   21 CONTINUE
      OPTION=0
      IF (RESPON .GE. 2) OPTION=1
      CALL TPLOT(HM,HP,NF,OPTION)
   20 CONTINUE
      RETURN
      END
      SUBROUTINE TPLOT(HM,HP,NF,OPTION)
      DIMENSION HM(1),HP(1)
      INTEGER OPTION
      DATA PI2/1.570796/
      CROS(X1,X2,Y1,Y2,YI)=(X2-X1)*(YI-Y1)/(Y2-Y1)+X1
      CALL SCALF(1.,1.,1)
      CALL OFFST(0.,0.,1)
      DF=6./FLOAT(NF-1)
      REF=0.
      IF (OPTION .EQ. 0) GO TO 1
      HMAX=HM(1)
      DO 2 JF=1,NF
    2 HMAX=AMAX1(HMAX,HM(JF))
      IF (HMAX .LE. 0.) HMAX=.0001
      REF=FLOAT(IFIX(ALOG10(HMAX)-.05))
    1 CONTINUE
      CALL PLOT(0.,0.,-3)
      CALL AXIS(0,5.5,10HLOG-10 MAG,10,4.,-3,1,PI2)
      CALL AXIS(0.,5.5,1HW,-1,6.,-4,1,0.)
      CALL AXIS(0.,.5,5HPHASE,5,4.,-3,1,PI2)
      CALL AXIS(0.,.5,1HW,-1,6.,-4,1,0.)
      CALL NUMPLT(-.05,.25,0.,-.1,.01,2)
      CALL NUMPLT(1.98,.25,0.,-.1,.1,1)
      CALL NUMPLT(4.02,.25,0.,-.1,1.,0)
      CALL NUMPLT(6.05,.25,0.,-.1,10.,0)
      CALL NUMPLT(-.05,.45,0.,-.1,-180.,-1)
      CALL NUMPLT(-.05,2.45,0.,-.1,0.,-1)
      CALL NUMPLT(-.05,4.45,0.,-.1,180.,-1)
      VNUM=REF-2.
      CALL NUMPLT(-.05,5.45,0.,-.1,VNUM,-1)
      CALL NUMPLT(-.05,9.45,0.,-.1,REF,-1)
      CALL PLOT(0.,5.5,3)
      IPEN=3
      XCL=0.
      YCL=0.
      IOUTL=0
      IOUTU=0
      DO 12 JF=1,NF
      XC=DF*FLOAT(JF-1)
      YC=5.
      IF (HM(JF) .GT. 0.) YC=2.*(ALOG10(HM(JF))-REF)+9.5
      IF (YC .GE. 5.5) GO TO 16
      IF (JF .EQ. 1) IOUTL=1
      IF (IOUTL .EQ. 1) GO TO 17
      IF (IOUTU .EQ. 0) GO TO 19
      XCR=CROS(XCL,XC,YCL+4.,YC,9.5)
      CALL PLOT(XCR,5.5,2)
      CALL PLOT(XCR,9.5,3)
   19 XCR=CROS(XCL,XC,YCL,YC,5.5)
      IOUTL=1
      IOUTU=0
      CALL PLOT(XCR,5.5,2)
      GO TO 17
   16 IF (YC .LE. 9.5) GO TO 11
      IF (JF .GT. 1) GO TO 18
      IOUTU=1
      GO TO 10
   18 IF (IOUTU .EQ. 1) GO TO 10
      XCR=CROS(XCL,XC,YCL,YC,9.5)
      IF (IOUTL .EQ. 1) CALL PLOT(XCR,5.5,3)
      IOUTU=1
      IOUTL=0
      CALL PLOT(XCR,9.5,2)
      CALL PLOT(XCR,5.5,3)
   10 YC=YC-4.
      GO TO 14
   11 IF (IOUTL .NE. 1) GO TO 13
      XCR=CROS(XCL,XC,YCL,YC,5.5)
      IOUTL=0
      CALL PLOT(XCR,5.5,3)
      GO TO 14
   13 IF (IOUTU .NE. 1) GO TO 14
      XCR=CROS(XCL,XC,YCL+4.,YC,9.5)
      IOUTU=0
      CALL PLOT(XCR,5.5,2)
      CALL PLOT(XCR,9.5,3)
   14 CALL PLOT(XC,YC,IPEN)
   17 XCL=XC
      YCL=YC
      IPEN=2
   12 CONTINUE
      CALL PLOT(0.,.5,3)
      DO 22 JF=1,NF
      XC=DF*FLOAT(JF-1)
      YC=HP(JF)/90.+2.5
      P=HP(JF)
      IF (JF .EQ. 1) GO TO 23
      IF ((P*PL .LT. 0.) .AND. (ABS(P) .GT. 90.) .AND. (ABS(PL) .GT. 90.-
     1)) GO TO 24
      CALL PLOT(XC,YC,2)
      GO TO 29
   23 CALL PLOT(XC,YC,3)
      GO TO 29
   24 IF (P .GT. 0.) GO TO 25
      XCR=CROS(XCL,XC,YCL,YC+4.,4.5)
      CALL PLOT(XCR,4.5,2)
      CALL PLOT(XCR,.5,3)
      CALL PLOT(XC,YC,2)
      GO TO 29
   25 XCR=CROS(XCL,XC,YCL,YC-4.,.5)
      CALL PLOT(XCR,.5,2)
      CALL PLOT(XCR,4.5,3)
      CALL PLOT(XC,YC,2)
   29 XCL=XC
      YCL=YC
      PL=P
   22 CONTINUE
      CALL PLOT(8.,0.,-3)
      RETURN
      END
      SUBROUTINE RPLOT(MX,MX1,LOOP,PLOTMX,LOCUS)
      COMMON /WORK/AH(3600),BH(3600),CH(3600),A(3600)
      DIMENSION EVR(60),EVI(60)
      INTEGER IER(60)
      DATA PI2/1.570796/
      MX2=2*MX-MX1
      MX2SQ=MX2*MX2
      DO 30 I=1,MX2SQ
   30 AH(I)=A(I)
      T=24.
      NEI=0
      CALL EIGENJ(MX2,MX2,AH,T,EVR,EVI,BH,CH,IER,NEI)
      CALL SCALF(1.,1.,1)
      CALL OFFST(0.,0.,1)
      CALL PLOT(0.,0.,-3)
      IF (LOOP .NE. 1) GO TO 40
      CALL PLOT(9.,0.,-3)
      EMAX=0.
      DO 20 I=1,MX2
   20 EMAX=AMAX1(EMAX,EVI(I))
      EMAX=AMIN1(EMAX,PLOTMX)
      EMAX=AMAX1(EMAX,1.9)
      AXLEN=2.*FLOAT(IFIX(2.*EMAX)+1)
      NTIC=IFIX(2.*EMAX)+2
      CALL AXIS(0.,8.5,4HREAL,-4,8.,-9,1,-PI2)
      CALL AXIS(0.,1.5,4HIMAG,-4,AXLEN,-NTIC,1,0.)
      CALL NUMPLT(-.2,6.5,-PI2,-.1,-.5,1)
      CALL NUMPLT(-.2,1.45,-PI2,-.1,0.,-1)
      NNUM=(NTIC-1)/2
      DO 21 I=1,NNUM
      XNUM=4.*FLOAT(I)-.05
      VNUM=FLOAT(I)
      CALL NUMPLT(XNUM,1.3,-PI2,-.1,VNUM,0)
   21 CONTINUE
      CALL PLOT(0.,0.,-3)
   40 DO 10 I=1,MX2
      IF ((EVI(I) .GT. PLOTMX) .OR. (EVI(I) .LT. 0.)) GO TO 10
      IF ((EVR(I) .GT. 0.1) .OR. (EVR(I) .LT. -0.7)) GO TO 10
      XC=-EVR(I)*10.+1.5
      YC=EVI(I)*4.
      IF (MOD(LOOP-1,LOCUS) .NE. 0) GO TO 5
      CALL GRAF(YC,XC,.07,1)
      GO TO 10
    5 CALL GRAF(YC,XC,.03,4)
   10 CONTINUE
      CALL PLOT(0.,0.,-3)
      RETURN
      END
      SUBROUTINE CSYSAN(N,MX,MX1,MV,A2,A1,A0,B0,NFREQ,FREQ,NSTEP,DOF1,FS-
     1CALE)
      DIMENSION A2(1),A1(1),A0(1),B0(1),FREQ(1)
      INTEGER DOF1(1)
      COMMON /WORK/AH(3600),BH(3600),CH(3600),A(3600)
      COMPLEX LAMDA(60),MODAL(3600),SUM
      EQUIVALENCE (MODAL(1),AH(1))
C  MAXIMUM MX2=60, MV=60
  960 FORMAT (/' *****   DIMENSIONS TOO SMALL   *****')
  961 FORMAT (1H1   /1X'ANALYSIS OF SYSTEM OF CONSTANT COEFFICIENT LINEA-
     1R DIFFERENTIAL EQUATIONS'  //10X,'NUMBER OF EQUATIONS AND VARIABLE-
     2S =',I3 /10X,'NUMBER OF FIRST ORDER VARIABLES =',I3               -
     3       / 10X,'NUMBER OF INPUTS/CONTROLS =',I3 )
  962 FORMAT (70X,2E15.5)
  963 FORMAT (55X,E15.5,F12.2,7X,2E15.5)
  969 FORMAT (36X,2F15.5,10X,F15.4)
  970 FORMAT(//  1X,'EIGENVALUES'/52X,'LAMDA',29X,'ZETA'/)
  983 FORMAT (1H1)
  985 FORMAT (10X,F10.5,F10.5,F12.5,F10.4,F15.3,F11.3,F17.4,F12.4,F12.4)
  986 FORMAT (1H1/1X,'EIGENVALUES'///14X,'REAL', 6X,'IMAG', 6X,'NAT FREQ-
     1', 5X,'ZETA', 8X,'FREQ (HZ)', 1X,'NAT FREQ (HZ)', 3X,'PERIOD (SEC)-
     2', 2X,'TAU (SEC)', 2X,'T-1/2 (SEC)'/)
  991 FORMAT (7X,'EQUATION NUMBER',I3,10X,'SUM =',E13.3,F9.2)
  995 FORMAT (   /5X,'TERMS IN ORIGINAL EQUATIONS')
  996 FORMAT(25X,3E15.5,F12.2,7X,2E15.5)
  997 FORMAT (   ////1X,'MODE NUMBER',I3/24X,'EIGENVALUE =',2F15.4 /34X,-
     1'FREQUENCY =',F23.4/34X,'NATURAL FREQUENCY =',F15.4/34X,'DAMPING R-
     2ATIO =',F19.4  //10X,'EIGENVECTOR --',27X,'DISPLACEMENT',39X,'VELO-
     3CITY'/33X,'REAL',8X,'IMAGINARY',6X,'MAGNITUDE',5X,'PHASE (DEG)')
  998 FORMAT (30X,2E15.5,10X,2E15.5)
  999 FORMAT (    ///1X,'MODE NUMBER',I3/24X,'EIGENVALUE =',2F15.4, 10X,-
     1'TIME CONSTANT =',F15.4 //10X,'EIGENVECTOR --',17X,'DISPLACEMENT',-
     230X,'VELOCITY')
      MX2=MX*2-MX1
      MXM1=MX-MX1
      IF ((MX2 .LE. 60) .AND. (MV .LE. 60)) GO TO 101
      PRINT 960
      RETURN
  101 CONTINUE
      CALL DETRAN(A,MX,MX1,MV,A2,A1,A0,B0,DOF1)
      NEI=1
      IF(MOD(N,10) .EQ. 0) NEI=0
      CALL EIGEN(NEI,A,MX2,LAMDA,MODAL,MX)
      PRINT 961, MX,MX1,MV
      PRINT 970
      DO 8 JL=1,MX2
      ZETA=-REAL(LAMDA(JL))/SQRT(REAL(LAMDA(JL))**2+AIMAG(LAMDA(JL))**2)
    8 PRINT 969, LAMDA(JL),ZETA
      IF (FSCALE .LE. 0.) GO TO 44
      PRINT 986
      DO 21 JL=1,MX2
      REL=REAL(LAMDA(JL))
      AIL=AIMAG(LAMDA(JL))
      OMEGAN=REL**2+AIL**2
      IF (OMEGAN .NE. 0.) OMEGAN=SQRT(ABS(OMEGAN))
      ZETA=1.E20
      IF (OMEGAN .NE. 0.) ZETA=-REL/OMEGAN
      FREQL=FSCALE/6.283185*ABS(AIL)
      FREQN=FSCALE/6.283185*OMEGAN
      PERIOD=0.
      IF (FREQL .NE. 0.) PERIOD=1./FREQL
      TAU=1.E20
      IF (REL .NE. 0.) TAU=-1./(FSCALE*REL)
      TAU2=.6931472*TAU
   21 PRINT 985, REL,AIL,OMEGAN,ZETA,FREQL,FREQN,PERIOD,TAU,TAU2
   44 CONTINUE
      IF (MOD(N,10) .EQ. 0) GO TO 45
      DO 1 JL=1,MX2
      REL=REAL(LAMDA(JL))
      AIL=AIMAG(LAMDA(JL))
      IF (ABS(AIL) .NE. 0.) GO TO 2
      TAU=-1./REL
      PRINT 999, JL,LAMDA(JL),TAU
      DO 7 JM=1,MXM1
      JM1=MX2*(JL-1)+MX+JM
      JM2=MX2*(JL-1)+JM
    7 PRINT 998, MODAL(JM1),MODAL(JM2)
      IF (MX1 .EQ. 0) GO TO 3
      DO 6 JM=1,MX1
      JM1=MX2*(JL-1)+MXM1+JM
    6 PRINT 962, MODAL(JM1)
      GO TO 3
    2 OMEGA=ABS(AIL)
      OMEGAN=SQRT(REL**2+AIL**2)
      ZETA=-REL/OMEGAN
      PRINT 997, JL,LAMDA(JL),OMEGA,OMEGAN,ZETA
      DO 4 JM=1,MXM1
      JM1=MX2*(JL-1)+MX+JM
      JM2=MX2*(JL-1)+JM
      SUM=CMPLX(SQRT(REAL(MODAL(JM1))**2+AIMAG(MODAL(JM1))**2),ATAN2(AIM-
     1AG(MODAL(JM1)),REAL(MODAL(JM1)))*57.29578)
    4 PRINT 996, MODAL(JM1),SUM,MODAL(JM2)
      IF (MX1 .EQ. 0) GO TO 3
      DO 5 JM=1,MX1
      JM1=MX2*(JL-1)+MXM1+JM
      SUM=CMPLX(SQRT(REAL(MODAL(JM1))**2+AIMAG(MODAL(JM1))**2),ATAN2(AIM-
     1AG(MODAL(JM1)),REAL(MODAL(JM1)))*57.29578)
    5 PRINT 963, SUM,MODAL(JM1)
    3 CONTINUE
      IF (MOD(N,10) .LE. 1) GO TO 1
      PRINT 995
      DO 11 JX=1,MX
      SUM=CMPLX(0.0,0.0)
      DO 12 JM=1,MX
      JX1=MX*(JM-1)+JX
      IF (JM .LE. MXM1) GO TO 13
      JM1=MX2*(JL-1)+JM
      SUM=SUM+MODAL(JM1)*(A2(JX1)*LAMDA(JL)+A1(JX1))
      GO TO 12
   13 JM1=MX2*(JL-1)+MX+JM
      SUM=SUM+MODAL(JM1)*((A2(JX1)*LAMDA(JL)+A1(JX1))*LAMDA(JL)+A0(JX1))
   12 CONTINUE
      SUM=CMPLX(SQRT(REAL(SUM)**2+AIMAG(SUM)**2),57.29578*ATAN2(AIMAG(SU-
     1M),REAL(SUM)))
      PRINT 991, JX,SUM
   11 CONTINUE
    1 CONTINUE
   45 CONTINUE
      IF (MV .EQ. 0) GO TO 66
      IF (N .LT. 10) GO TO 61
      PRINT 983
      SUM=CMPLX(1.,0.)
      DO 62 JL=1,MX2
   62 SUM=SUM*LAMDA(JL)
      PRPOLE=REAL(SUM)
      DO 67 JX=1,MX
      DO 67 NV=1,MV
      NX=JX+MXM1
   67 CALL ZERO(A,B0,MX2,MX,MV,NX,NV,PRPOLE)
   61 IF (NSTEP .EQ. 0) GO TO 68
      PRINT 983
      CALL STATIC(A,B0,MX,MX1,MV)
   68 IF (NFREQ .EQ. 0) GO TO 66
      PRINT 983
      DO 64 JX=1,MX2
      DO 64 JXX=1,MX2
      JA=(JX-1)*MX2+JXX
      AH(JA)=0.
      DO 64 JI=1,MX2
      JA1=(JX-1)*MX2+JI
      JA2=(JI-1)*MX2+JXX
   64 AH(JA)=AH(JA)+A(JA1)*A(JA2)
      DO 65 JW=1,NFREQ
      W=FREQ(JW)
   65 CALL SINE(W,A,AH,B0,MX,MX1,MV)
   66 RETURN
      END
      SUBROUTINE DETRAN(A,MX,MX1,MV,A2,A1,A0,B0,DOF1)
      DIMENSION A(1),A2(1),A1(1),A0(1),B0(1)
      INTEGER DOF1(1)
      COMMON /WORK/AH(3600),BH(3600),CH(3600),AAA(3600)
      INTEGER ORD(60)
      DIMENSION AH1(3600),AH2(3600),BH1(3600),BH2(3600),CH1(3600),LH(61)-
     1,MH(61)
      EQUIVALENCE (BH1(1),AH(1)),(BH2(1),BH(1)),(CH1(1),CH(1)),(AH1(1),A-
     1H(1)),(AH2(1),BH(1))
C  MAXIMUM MX=60, MV=60
  999 FORMAT (///5X,'*****  CSYSAN/DETRAN  --   MATRIX A2 IS SINGULAR   -
     1*****')
      MX2=2*MX-MX1
      MXM1=MX-MX1
      MXSQ=MX*MX
      MVX=MV*MX
      IF (MX1 .EQ. 0) GO TO 69
      JX1=0
      JX2=MXM1
      DO 61 JX=1,MX
      IF (DOF1(JX) .EQ. 0) GO TO 62
      JX1=JX1+1
      JXX=JX1
      GO TO 61
   62 JX2=JX2+1
      JXX=JX2
   61 ORD(JX)=JXX
      DO 63 JX=1,MX
      DO 63 JXX=1,MX
      JA1=(JX-1)*MX+JXX
      JA2=(ORD(JX)-1)*MX+ORD(JXX)
      BH1(JA2)=A2(JA1)
      BH2(JA2)=A1(JA1)
   63 CH1(JA2)=A0(JA1)
      DO 64 JX=1,MXSQ
      A2(JX)=BH1(JX)
      A1(JX)=BH2(JX)
   64 A0(JX)=CH1(JX)
      IF (MV .LE. 0) GO TO 69
      DO 65 JX=1,MX
      DO 65 JV=1,MV
      JA1=(JV-1)*MX+JX
      JA2=(JV-1)*MX+ORD(JX)
   65 CH1(JA2)=B0(JA1)
      DO 66 JX=1,MVX
   66 B0(JX)=CH1(JX)
   69 CONTINUE
    1 DO 201 JX=1,MXSQ
  201 CH(JX)=A2(JX)
      CALL MINV(CH,MX,DET,LH,MH)
      IF (DET .EQ. 0.0) PRINT  999
    2 IF (MV .EQ. 0) GO TO 301
      DO 23 JV=1,MV
      DO 23 JX=1,MX
      JB=(JV-1)*MX+JX
      BH2(JB)=0.0
      DO 23 JI=1,MX
      JB1=(JV-1)*MX+JI
      JB2=(JI-1)*MX+JX
   23 BH2(JB)=BH2(JB)+CH(JB2)*B0(JB1)
      DO 24 JX=1,MVX
   24 B0(JX)=BH2(JX)
  301 CONTINUE
      DO 27 JX=1,MX
      DO 27 JXX=1,MX
      JA=(JX-1)*MX+JXX
      AH2(JA)=0.0
      AH1(JA)=0.0
      DO 27 JI=1,MX
      JA1=(JX-1)*MX+JI
      JA2=(JI-1)*MX+JXX
      AH2(JA)=AH2(JA)+CH(JA2)*A1(JA1)
   27 AH1(JA)=AH1(JA)+CH(JA2)*A0(JA1)
    3 DO 231 JX=1,MX
      DO 232 JXX=1,MX
      JA1=(JX-1)*MX+JXX
      JA=(JX-1)*MX2+JXX
      A(JA)=-AH2(JA1)
      JA=JA+MX
      IF (JXX .LE. MXM1) A(JA)=0.0
      IF (JX .GT. MXM1) GO TO 232
      JA=(MX+JX-1)*MX2+JXX
      A(JA)=-AH1(JA1)
      JA=JA+MX
      IF (JXX .LE. MXM1) A(JA)=0.0
  232 CONTINUE
      JA=(JX-1)*MX2+MX+JX
      IF (JX .LE. MXM1) A(JA)=1.0
  231 CONTINUE
      RETURN
      END
      SUBROUTINE SINE(W,A,ASQ,B0,MX,MX1,MV)
      DIMENSION A(1),B0(1),ASQ(1)
      DIMENSION LH(61),MH(61)
      COMPLEX CHC(60)
      COMMON /WORK/AH(3600),BH(3600),CH(3600),AAA(3600)
C  MAXIMUM MX2=60, MV=60
  999 FORMAT (///' FREQUENCY RESPONSE, MAG/PHASE  *****    W = ',F10.3/)
  998 FORMAT (1X,'X',I2,'/V')
  997 FORMAT (8X,7(F10.4,'/',F6.1))
      MX2=2*MX-MX1
      MXM1=MX-MX1
      DO 11 JX=1,MX2
      DO 12 JXX=1,MX2
      JA=(JX-1)*MX2+JXX
   12 CH(JA)=ASQ(JA)
      JA=(JX-1)*MX2+JX
   11 CH(JA)=CH(JA)+W*W
      CALL MINV(CH,MX2,DET,LH,MH)
      DO 15 JV=1,MV
      DO 15 JX=1,MX2
      JB=(JV-1)*MX2+JX
      BH(JB)=0.
      DO 15 JI=1,MX
      JB1=(JV-1)*MX+JI
      JA1=(JI-1)*MX2+JX
   15 BH(JB)=BH(JB)+CH(JA1)*B0(JB1)
      PRINT 999, W
      DO 19 JX=1,MX
      PRINT 998, JX
      DO 17 JV=1,MV
      JC=(JV-1)*MX2+MXM1+JX
      B7=W*BH(JC)
      B6=0.
      DO 18 JI=1,MX2
      JA1=(JI-1)*MX2+JX+MXM1
      JB1=(JV-1)*MX2+JI
   18 B6=B6-A(JA1)*BH(JB1)
      CHC(JV)=CMPLX(0.,0.)
      IF ((B6 .NE. 0.) .OR. (B7 .NE. 0.)) CHC(JV)=CMPLX(SQRT(B6*B6+B7*B7-
     1),57.29578*ATAN2(-B7,B6))
   17 CONTINUE
   19 PRINT 997, (CHC(JV), JV=1,MV)
      RETURN
      END
      SUBROUTINE STATIC(A,B0,MX,MX1,MV)
      DIMENSION A(1),B0(1)
      DIMENSION CH1(60),LH(61),MH(61)
      COMMON /WORK/AH(3600),BH(3600),CH(3600),AAA(3600)
C  MAXIMUM MX2=60, MV=60
  999 FORMAT (/' STEADY STATE RESPONSE'//)
  998 FORMAT (1X,'X',I2,'/V')
  997 FORMAT (10X,10F10.5)
      MX2=2*MX-MX1
      MXM1=MX-MX1
      MX2SQ=MX2*MX2
      DO 11 JX=1,MX2SQ
   11 AH(JX)=A(JX)
      CALL MINV(AH,MX2,DET,LH,MH)
      PRINT 999
      DO 15 JX=1,MX
      DO 17 JV=1,MV
      CH1(JV)=0.
      DO 17 JI=1,MX
      JA1=(JI-1)*MX2+JX+MXM1
      JB1=(JV-1)*MX+JI
   17 CH1(JV)=CH1(JV)-AH(JA1)*B0(JB1)
      PRINT 998, JX
   15 PRINT 997, (CH1(JV), JV=1,MV)
      RETURN
      END
      SUBROUTINE ZERO(A,B0,MX2,MX,MV,NX,NV,PRPOLE)
      DIMENSION A(1),B0(1)
      COMMON /WORK/AH(3600),BH(3600),CH(3600),DH(3600)
      DIMENSION Z(3600),VR(3600),VI(3600),RR(60),RI(60),IER(60)
      EQUIVALENCE (Z(1),AH(1)),(VR(1),BH(1)),(VI(1),CH(1))
      REAL K1,K2
      COMPLEX PRZERO
C  MAXIMUM MX2=60
  999 FORMAT (///5X,'ZEROS OF  X',I2,'/V',I1,5X,'**  NOT CONTROLLABLE  *-
     1*')
  998 FORMAT (///5X,'ZEROS OF  X',I2,'/V',I1,5X,'**  NONE  **')
  997 FORMAT (///5X,'ZEROS OF  X',I2,'/V',I1,5X,'**  MZ = ',I2,'  **'/52-
     1X,'ZEROS',29X,'ZETA'/)
  996 FORMAT (36X,2F15.5,10X,F15.4)
  995 FORMAT (/50X,'K1 =',E14.5/50X,'K2 =',F10.5,5X,'(STATIC RESPONSE)')
      DO 11 JX=1,MX2
      JCOL=JX-NX+1
      IF (JCOL .LE. 0) JCOL=JCOL+MX2
      DO 11 JXX=1,MX2
      JROW=JXX-NX+1
      IF (JROW .LE. 0) JROW=JROW+MX2
      IF (JX .EQ. NX) GO TO 12
      JX1=(JX-1)*MX2+JXX
      S=A(JX1)
      GO TO 13
   12 S=0.
      JX1=(NV-1)*MX+JXX
      IF (JXX .LE. MX) S=B0(JX1)
   13 JX2=(JCOL-1)*MX2+JROW
   11 Z(JX2)=S
      MZ=MX2
      CALL ZETRAN(Z,MZ)
      IF (MZ .GE. 0) GO TO 1
      PRINT 999, NX,NV
      RETURN
    1 IF (MZ .GE. 1) GO TO 2
      PRINT 998, NX,NV
      K1=Z(1)
      K2=K1/PRPOLE
      PRINT 995, K1,K2
      RETURN
    2 PRINT 997, NX,NV,MZ
      MZSQ=MZ*MZ
      K1=Z(MZSQ+1)
      NEI=0
      T=24.
      CALL EIGENJ(MZ,MZ,Z,T,RR,RI,VR,VI,IER,NEI)
      PRZERO=CMPLX(1.,0.)
      DO 3  I=1,MZ
      PRZERO=PRZERO*CMPLX(RR(I),RI(I))
      ZETA=RR(I)**2+RI(I)**2
      IF (ZETA .GT. 0.) ZETA=-RR(I)/SQRT(ZETA)
    3 PRINT 996, RR(I),RI(I),ZETA
      K2=K1*REAL(PRZERO)/PRPOLE
      PRINT 995, K1,K2
      RETURN
      END
      SUBROUTINE ZETRAN(Z,MZ)
      DIMENSION Z(1)
      COMMON /WORK/AH(3600),BH(3600),CH(3600),DH(3600)
      REAL DZ(3600),A1,AMAX
      EQUIVALENCE (BH(1),DZ(1))
      REAL K1
C  MAXIMUM MZ=60
      K1=-1.
      MZSQ=MZ*MZ
      DO 1 I=1,MZSQ
    1 DZ(I)=Z(I)
    2 IF (DZ(1) .EQ. 0.) GO TO 3
      DO 11 I=2,MZ
      A1=DZ(I)/DZ(1)
      DO 11 K=2,MZ
      JZ1=(K-1)*MZ+1
      JZ2=(K-1)*MZ+I
   11 DZ(JZ2)=DZ(JZ2)-A1*DZ(JZ1)
      K1=DZ(1)*K1
      JZ=0
      DO 12 K=2,MZ
      DO 12 I=2,MZ
      JZ=JZ+1
      JZ1=(K-1)*MZ+I
   12 DZ(JZ)=DZ(JZ1)
      MZ=MZ-1
      MZSQ=MZ*MZ
      DO 4 I=1,MZSQ
    4 Z(I)=DZ(I)
      Z(MZSQ+1)=K1
      RETURN
    3 IF (MZ .EQ. 2) GO TO 5
      AMAX=DZ(2)
      IMAX=2
      DO 21 I=3,MZ
      IF (ABS(AMAX) .GT. ABS(DZ(I))) GO TO 21
      AMAX=DZ(I)
      IMAX=I
   21 CONTINUE
      IF (AMAX .NE. 0.) GO TO 6
      MZ=-1
      RETURN
    6 DO 31 I=2,MZ
      IF (I .EQ. IMAX) GO TO 31
      A1=DZ(I)/DZ(IMAX)
      DO 32 K=2,MZ
      JZ1=(K-1)*MZ+IMAX
      JZ2=(K-1)*MZ+I
   32 DZ(JZ2)=DZ(JZ2)-A1*DZ(JZ1)
   31 CONTINUE
      DO 33 K=2,MZ
      IF (K .EQ. IMAX) GO TO 33
      A1=DZ(K)/DZ(IMAX)
      DO 34 I=1,MZ
      JZ1=(IMAX-1)*MZ+I
      JZ2=(K-1)*MZ+I
   34 DZ(JZ1)=DZ(JZ1)+A1*DZ(JZ2)
   33 CONTINUE
      IF (IMAX .EQ. 2) GO TO 35
      DO 36 I=1,MZ
      JZ1=(IMAX-1)*MZ+I
   36 DZ(I)=DZ(JZ1)
      DO 37 I=2,IMAX
      DO 37 K=1,MZ
      JZ1=(IMAX-I)*MZ+K
      JZ2=JZ1+MZ
   37 DZ(JZ2)=DZ(JZ1)
   35 K1=-AMAX*K1
      JZ=0
      DO 38 K=2,MZ
      DO 38 I=1,MZ
      IF (I .EQ. IMAX) GO TO 38
      JZ=JZ+1
      JZ1=(K-1)*MZ+I
      DZ(JZ)=DZ(JZ1)
   38 CONTINUE
      MZ=MZ-1
      GO TO 2
    5 A1=DZ(2)*DZ(3)
      IF (A1 .NE. 0.) MZ=0
      IF (A1 .EQ. 0.) MZ=-1
      Z(1)=-A1*K1
      RETURN
      END
      SUBROUTINE PSYSAN(N,MX,MX1,A2,A1,A0,PHI,DT,NT,MT,PERIOD,MTP,DOF1)
      DIMENSION A2(1),A1(1),A0(1),PHI(1)
      INTEGER DOF1(1)
      COMMON /WORK/AH(3600),BH(3600),CH(3600),A(3600)
      DIMENSION T(101)
      COMPLEX LAMDAC(60),LAMDA(60),MODAL(3600),PS(3600),EXPL,AHH(4)
      EQUIVALENCE (MODAL(1),AH(1)),(PS(1),CH(1))
C  MAXIMUM MX2=60
  960 FORMAT (/' *****   DIMENSIONS TOO SMALL   *****')
  961 FORMAT(1H1  //1X,'ANALYSIS OF SYSTEM OF PERIODIC COEFFICIENT LINEA-
     1R DIFFERENTIAL EQUATIONS'////10X,'NUMBER OF EQUATIONS AND VARIABLE-
     2S  =',I3/ 10X,'NUMBER OF FIRST ORDER VARIABLES  =',I3/ 10X,'NUMBER-
     3 OF TIME STEPS =',I5/ 10X,'PERIOD OF THE SYSTEM =',F9.4)
  962 FORMAT (/' *****   MT NOT EQUAL TO A MULTIPLE OF MTP   *****')
  999 FORMAT (///10X,'EIGENVALUES, PRINCIPAL VALUE   ( N(2*PI)/T * I  IN-
     1 LAMBDA SUPPRESSED'//20X,'MODE',20X,'LAMDA',30X,'LAMDAC')
  998 FORMAT (20X,I3,5X,2F15.4,5X,2F15.4)
  997 FORMAT (1H1//5X,'MODE SHAPES  --  COLUMNS ARE MODES, ORDERED SAME -
     1AS ROOTS'/ 22X,'DISPLACEMENT ONLY, TOP MX1 ARE FIRST ORDER VARIABL-
     2ES (VELOCITY)'//)
  996 FORMAT (5X,8E14.5)
  995 FORMAT (/)
  994 FORMAT ( /2X,'T =',F9.4)
  993 FORMAT (10X,E17.5,F8.1,E17.5,F8.1,E17.5,F8.1,E17.5,F8.1)
      MX2=MX*2-MX1
      MX2SQ=MX2*MX2
      MX21=MX2-MX+1
      IF (MX2 .LE. 60) GO TO 101
      PRINT 960
      RETURN
  101 MT2=IABS(MTP)
      IF ((MT/MT2*MT2 .EQ. MT) .OR. (N .EQ. 0)) GO TO 102
      PRINT 962
      RETURN
  102 IF (NT .NE. 0) GO TO 1
      CALL DEPRAN(A,MX,MX1,A2,A1,A0,DOF1)
      DO 11 JX=1,MX2SQ
      PHI(JX)=0.0
      JX1=JX+MX2SQ
   11 PHI(JX1)=A(JX)
      DO 12 JX=1,MX2
      JXX=(JX-1)*MX2+JX
   12 PHI(JXX)=1.0
      TT=0.0
      T(1)=0.0
      RETURN
    1 KX1=((NT+MT2-2)/MT2)*MX2SQ
      IF (N .EQ. 0) KX1=0
      KX2=KX1+MX2SQ
      KX3=((NT+MT2-1)/MT2)*MX2SQ
      IF (N .EQ. 0) KX3=0
      KX4=KX3+MX2SQ
      DT2=0.5*DT
      CALL DEPRAN(A,MX,MX1,A2,A1,A0,DOF1)
      DO 21 JX=1,MX2SQ
      JX1=JX+KX2
      BH(JX)=A(JX)+PHI(JX1)
   21 AH(JX)=DT2*BH(JX)
      DO 23 JX=1,MX2
      DO 23 JXX=1,MX2
      JA1=(JXX-1)*MX2+JX
      DO 24 JI=1,MX2
      JA2=(JI-1)*MX2+JX
      JA3=(JXX-1)*MX2+JI
   24 BH(JA1)=BH(JA1)+A(JA2)*AH(JA3)
   23 BH(JA1)=DT2*BH(JA1)
      DO 27 JX=1,MX2
      DO 27 JXX=1,MX2
      JA1=(JXX-1)*MX2+JX
      AH(JA1)=0.0
      DO 27 JI=1,MX2
      JA2=(JI-1)*MX2+JX
      JA3=KX1+(JXX-1)*MX2+JI
   27 AH(JA1)=AH(JA1)+BH(JA2)*PHI(JA3)
      DO 28 JX=1,MX2SQ
      JX1=JX+KX1
      JX3=JX+KX3
      JX4=JX+KX4
      PHI(JX3)=PHI(JX1)+AH(JX)
      IF (NT .NE. MT) PHI(JX4)=A(JX)
   28 CONTINUE
      TT=TT+DT
      JT1=NT/MT2+1
      IF ((N .NE. 0) .AND. (NT/MT2*MT2 .EQ. NT)) T(JT1)=TT
   33 IF (NT .NE. MT) RETURN
      DO 31 JX=1,MX2SQ
      JX3=JX+KX3
   31 A(JX)=PHI(JX3)
      NEI=0
      IF (N .NE. 0) NEI=1
      CALL EIGEN(NEI,A,MX2,LAMDAC,MODAL,MX)
      DO 32 JX=1,MX2
      RE=REAL(LAMDAC(JX))
      AI=AIMAG(LAMDAC(JX))
      AB=SQRT(RE**2+AI**2)
      AN=ATAN2(AI,RE)
   32 LAMDA(JX)=CMPLX(ALOG(AB)/PERIOD,AN/PERIOD)
      PRINT 961, MX,MX1,MT,PERIOD
      PRINT 999
      DO 41 JX=1,MX2
   41 PRINT 998, JX,LAMDA(JX),LAMDAC(JX)
      IF (N .EQ. 0) RETURN
      PRINT 997
      MT1=MT/MT2+1
      DO 42 JT=1,MT1
      KX1=(JT-1)*MX2SQ
      TT=T(JT)
      PRINT 994, TT
      DO 45 JX=MX21,MX2
      DO 45 JXX=1,MX2
      JA1=(JXX-1)*MX2+JX
      PS(JA1)=CMPLX(0.0,0.0)
      DO 45 JI=1,MX2
      JA2=KX1+(JI-1)*MX2+JX
      JA3=(JXX-1)*MX2+JI
   45 PS(JA1)=PS(JA1)+PHI(JA2)*MODAL(JA3)
      DO 47 JX=1,MX2
      RE=EXP(-REAL(LAMDA(JX))*TT)
      AI=AIMAG(LAMDA(JX))*TT
      EXPL=CMPLX(RE*COS(AI),-RE*SIN(AI))
      DO 47 JXX=MX21,MX2
      JA1=(JX-1)*MX2+JXX
   47 PS(JA1)=PS(JA1)*EXPL
      IF (MTP .LT. 0) GO TO 46
      JM1=-4
   50 JM1=JM1+4
      JM2=MIN0(MX2-JM1,4)
      PRINT 995
      DO 48 JX=MX21,MX2
      DO 49 JXX=1,JM2
      JA1=(JM1+JXX-1)*MX2+JX
      RE=REAL(PS(JA1))
      AI=AIMAG(PS(JA1))
   49 AHH(JXX)=CMPLX(SQRT(RE*RE+AI*AI),57.29578*ATAN2(AI,RE))
   48 PRINT 993, (AHH(JXX),JXX=1,JM2)
      IF ((JM1+4) .LT. MX2) GO TO 50
      GO TO 42
   46 JM1=-4
   51 JM1=JM1+4
      JM2=MIN0(MX2-JM1,4)
      PRINT 995
      DO 52 JX=MX21,MX2
      DO 53 JXX=1,JM2
      JA1=(JM1+JXX-1)*MX2+JX
   53 AHH(JXX)=PS(JA1)
   52 PRINT 996, (AHH(JXX), JXX=1,JM2)
      IF ((JM1+4) .LT. MX2) GO TO 51
   42 CONTINUE
      RETURN
      END
      SUBROUTINE DEPRAN(A,MX,MX1,A2,A1,A0,DOF1)
      DIMENSION A(1),A2(1),A1(1),A0(1)
      INTEGER DOF1(1)
      COMMON /WORK/AH(3600),BH(3600),CH(3600),AAA(3600)
      INTEGER ORD(60)
      DIMENSION AH1(3600),AH2(3600),BH1(3600),BH2(3600),CH1(3600),LH(61)-
     1,MH(61)
      EQUIVALENCE (BH1(1),AH(1)),(BH2(1),BH(1)),(CH1(1),CH(1)),(AH1(1),A-
     1H(1)),(AH2(1),BH(1))
C  MAXIMUM MX=60
  999 FORMAT (///5X,'*****  PSYSAN/DEPRAN  --   MATRIX A2 IS SINGULAR   -
     1*****')
      MX2=2*MX-MX1
      MXM1=MX-MX1
      MXSQ=MX*MX
      IF (MX1 .EQ. 0) GO TO 69
      JX1=0
      JX2=MXM1
      DO 61 JX=1,MX
      IF (DOF1(JX) .EQ. 0) GO TO 62
      JX1=JX1+1
      JXX=JX1
      GO TO 61
   62 JX2=JX2+1
      JXX=JX2
   61 ORD(JX)=JXX
      DO 63 JX=1,MX
      DO 63 JXX=1,MX
      JA1=(JX-1)*MX+JXX
      JA2=(ORD(JX)-1)*MX+ORD(JXX)
      BH1(JA2)=A2(JA1)
      BH2(JA2)=A1(JA1)
   63 CH1(JA2)=A0(JA1)
      DO 64 JX=1,MXSQ
      A2(JX)=BH1(JX)
      A1(JX)=BH2(JX)
   64 A0(JX)=CH1(JX)
   69 CONTINUE
    1 DO 201 JX=1,MXSQ
  201 CH(JX)=A2(JX)
      CALL MINV(CH,MX,DET,LH,MH)
      IF (DET .EQ. 0.0) PRINT 999
    2 DO 27 JX=1,MX
      DO 27 JXX=1,MX
      JA=(JX-1)*MX+JXX
      AH2(JA)=0.0
      AH1(JA)=0.0
      DO 27 JI=1,MX
      JA1=(JX-1)*MX+JI
      JA2=(JI-1)*MX+JXX
      AH2(JA)=AH2(JA)+CH(JA2)*A1(JA1)
   27 AH1(JA)=AH1(JA)+CH(JA2)*A0(JA1)
    3 DO 231 JX=1,MX
      DO 232 JXX=1,MX
      JA1=(JX-1)*MX+JXX
      JA=(JX-1)*MX2+JXX
      A(JA)=-AH2(JA1)
      JA=JA+MX
      IF (JXX .LE. MXM1) A(JA)=0.0
      IF (JX .GT. MXM1) GO TO 232
      JA=(MX+JX-1)*MX2+JXX
      A(JA)=-AH1(JA1)
      JA=JA+MX
      IF (JXX .LE. MXM1) A(JA)=0.0
  232 CONTINUE
      JA=(JX-1)*MX2+MX+JX
      IF (JX .LE. MXM1) A(JA)=1.0
  231 CONTINUE
      RETURN
      END
      SUBROUTINE EIGEN(N,A,MX2,LAMDA,MODAL,MX)
      DIMENSION A(1)
      COMPLEX LAMDA(1),MODAL(1)
      COMMON /WORK/AH(3600),BH(3600),CH(3600),AAA(3600)
      COMPLEX SUM
      DIMENSION ROOTR(60),ROOTI(60),IER(60)
      REAL MODER(3600),MODEI(3600)
      EQUIVALENCE (MODER(1),BH(1)),(MODEI(1),CH(1))
C  MAXIMUM MX2=60
      NEI=N
      MX2SQ=MX2*MX2
      NX1=MX2
      NX2=MX2
      T=24.
      DO 1 JX=1,MX2SQ
    1 AH(JX)=A(JX)
      CALL EIGENJ(NX1,NX2,AH,T,ROOTR,ROOTI,MODER,MODEI,IER,NEI)
      DO 2 JM=1,MX2
    2 LAMDA(JM)=CMPLX(ROOTR(JM),ROOTI(JM))
      IF (NEI .EQ. 0) RETURN
      DO 3 JX=1,MX2SQ
    3 MODAL(JX)=CMPLX(MODER(JX),MODEI(JX))
      DO 20 JM=1,MX2
      SUMR2=0.
      DO 21 JMM=1,MX
      JM1=MX2*JM-JMM+1
      SUMR1=REAL(MODAL(JM1))**2+AIMAG(MODAL(JM1))**2
      IF (SUMR1 .LT. SUMR2) GO TO 21
      SUMR2=SUMR1
      SUM=MODAL(JM1)
   21 CONTINUE
      DO 20 JMM=1,MX2
      JM1=MX2*(JM-1)+JMM
   20 MODAL(JM1)=MODAL(JM1)/SUM
      RETURN
      END
      SUBROUTINE EIGENJ(N,NM,A,T,EVR,EVI,VECR,VECI,INDIC,NEI)
      DOUBLE PRECISION D1,D2,D3,PRFACT
      DIMENSION A(NM,1),VECR(NM,1),VECI(NM,1),                          -
     1EVR(NM),EVI(NM),INDIC(NM)
      DIMENSION IWORK(100),LOCAL(100),PRFACT(100)                       -
     1,SUBDIA(100),WORK1(100),WORK2(100),WORK(100)
      DATA IWORK,LOCAL,PRFACT,SUBDIA,WORK1,WORK2,WORK/100*0,100*0,      -
     1 100*0.0D0,100*0.0,100*0.0,100*0.0,100*0.0/
      DATA D1,D2,D3,I,IVEC,J,K,K1,KON,L,L1,ENORM,EPS,EX,R,R1/3*0.0D0,   -
     18*0,5*0.0/
      IF(N.NE.1) GO TO 1
      EVR(1) = A(1,1)
      EVI(1) = 0.0
      VECR(1,1) = 1.0
      VECI(1,1) = 0.0
      INDIC(1) = 2
      GO TO 25
    1 CALL SCALEM(N,NM,A,VECI,PRFACT,ENORM)
      EX = EXP(-T *ALOG(2.0))
      CALL HESQR(N,NM,A,VECI,EVR,EVI,SUBDIA,INDIC,EPS,EX)
      IF (NEI .EQ. 0) GO TO 41
      J = N
      I = 1
      LOCAL(1) = 1
      IF(J.EQ.1) GO TO 4
    2 IF(ABS(SUBDIA(J-1)).GT.EPS) GO TO 3
      I = I+1
      LOCAL(I)=0
    3 J = J-1
      LOCAL(I)=LOCAL(I)+1
      IF(J.NE.1)GO TO 2
    4 K = 1
      KON = 0
      L = LOCAL(1)
      M = N
      DO 10 I=1,N
        IVEC = N-I+1
        IF(I.LE.L)GO TO 5
        K = K+1
        M = N-L
        L = L+LOCAL(K)
    5   IF(INDIC(IVEC).EQ.0)GO TO 10
        IF(EVI(IVEC).NE.0.0)GO TO 8
      DO 7 K1=1,M
        DO 6 L1=K1,M
    6     A(K1,L1) = VECI(K1,L1)
        IF(K1.EQ.1)GO TO 7
        A(K1,K1-1) = SUBDIA(K1-1)
    7 CONTINUE
      CALL REALVE(N,NM,M,IVEC,A,VECR,EVR,EVI,IWORK,WORK,INDIC,EPS,EX)
      GO TO 10
    8 IF(KON.NE.0)GO TO 9
      KON = 1
      CALL COMPVE(N,NM,M,IVEC,A,VECR,VECI,EVR,EVI,INDIC,                -
     1  IWORK,SUBDIA,WORK1,WORK2,WORK,EPS,EX)
        GO TO 10
    9   KON = 0
   10   CONTINUE
      DO 12 I=1,N
        DO 11 J=I,N
          A(I,J)=0.0
   11     A(J,I)=0.0
   12   A(I,I) = 1.0
      IF(N.LE.2)GO TO 15
      M = N-2
      DO 14 K=1,M
        L = K+1
        DO 14 J=2,N
          D1 = 0.0
          DO 13 I=L,N
            D2 = VECI(I,K)
   13       D1 = D1+D2*A(J,I)
      DO 14 I=L,N
   14 A(J,I) = A(J,I)-VECI(I,K)*D1
   15 KON = 1
      DO 24 I=1,N
      ISW=INDIC(I)-1
      IF(ISW)24,152,152
  152 L=0
      IF(EVI(I).EQ.0.0)GO TO 16
      L = 1
      IF(KON.EQ.0)GO TO 16
      KON = 0
      GO TO 24
   16 IF(ISW)24,161,162
  161 IF(L)232,202,232
  162 DO 18 J=1,N
      D1 =0.0
      D2 = 0.0
      DO 17 K=1,N
      D3 = A(J,K)
      D1 = D1+D3*VECR(K,I)
      IF(L.EQ.0)GO TO 17
      D2 = D2+D3*VECR(K,I-1)
   17 CONTINUE
      WORK(J) = D1/PRFACT(J)
      IF(L.EQ.0)GO TO 18
      SUBDIA(J)=D2/PRFACT(J)
   18 CONTINUE
      IF(L.EQ.1)GO TO 21
      D1 = 0.0
      DO 19 M=1,N
   19 D1 = D1+WORK(M)**2
      D1 = DSQRT(D1)
      DO 20 M=1,N
      VECI(M,I) = 0.0
   20 VECR(M,I) = WORK(M)/D1
  202 EVR(I)=EVR(I)*ENORM
      GO TO 24
   21 R=0.
      DO 22 J=1,N
      R1 = WORK(J)**2 + SUBDIA(J)**2
      IF(R.GE.R1)GO TO 22
      R = R1
      L = J
   22 CONTINUE
      D3 = WORK(L)
      R1 = SUBDIA(L)
      DO 23 J=1,N
      D1 = WORK(J)
      D2 = SUBDIA(J)
      VECR(J,I) = (D1*D3+D2*R1)/R
      VECI(J,I) = (D2*D3-D1*R1)/R
      VECR(J,I-1) = VECR(J,I)
   23 VECI(J,I-1) =-VECI(J,I)
  232 KON=1
      EVR(I)=EVR(I)*ENORM
      EVR(I-1)=EVR(I)
      EVI(I)=EVI(I)*ENORM
      EVI(I-1)=-EVI(I)
   24 CONTINUE
   25 RETURN
   41 DO 42 I=1,N
      EVR(I)=EVR(I)*ENORM
   42 EVI(I)=EVI(I)*ENORM
      RETURN
      END
      SUBROUTINE SCALEM(N,NM,A,H,PRFACT,ENORM)
      DOUBLE PRECISION COLUMN,FACTOR,FNORM,PRFACT,Q,ROW
      DIMENSION A(NM,1),H(NM,1),PRFACT(NM)
      DATA COLUMN,FACTOR,FNORM,Q,ROW/5*0.0D0/
      DATA I,J,ITER,NCOUNT/4*0/
      DATA BOUND1,BOUND2,BOUND  /3*0.0/
      DO 2 I=1,N
      DO 1 J=1,N
    1 H(I,J) = A(I,J)
    2 PRFACT(I) = 1.0
      BOUND1 =  0.75
      BOUND  =  1.33
      BOUND2 =  1.33
      ITER = 0
    3 NCOUNT = 0
      DO 8 I=1,N
      COLUMN = 0.0
      ROW = 0.0
      DO 4 J=1,N
      IF(I.EQ.J)GO TO 4
      COLUMN = COLUMN+ ABS(A(J,I))
      ROW = ROW + ABS(A(I,J))
    4 CONTINUE
      IF(COLUMN.EQ.0.0)GO TO 5
      IF(ROW.EQ.0.0)GO TO 5
      Q = COLUMN/ROW
      IF(Q.LT.BOUND1)GO TO 6
      IF(Q.GT.BOUND2)GO TO 6
    5 NCOUNT = NCOUNT + 1
      GO TO 8
    6 FACTOR = DSQRT(Q)
      DO 7 J=1,N
      IF(I.EQ.J)GO TO 7
      A(I,J) = A(I,J)*FACTOR
      A(J,I) = A(J,I)/FACTOR
    7 CONTINUE
      PRFACT(I) = PRFACT(I)*FACTOR
    8 CONTINUE
      ITER = ITER+1
      IF(ITER.GT.30)GO TO 11
      IF(NCOUNT.LT.N)GO TO 3
      FNORM = 0.0
      DO 9 I=1,N
      DO 9 J=1,N
      Q = A(I,J)
    9 FNORM = FNORM+Q*Q
      FNORM = DSQRT(FNORM)
      DO 10 I=1,N
      DO 10 J=1,N
   10 A(I,J)=A(I,J)/FNORM
      ENORM = FNORM
      GO TO 13
   11 DO 12 I=1,N
      DO 12 J=1,N
      PRFACT(I)=1.0
   12 A(I,J) = H(I,J)
      ENORM = 1.0
   13 RETURN
      END
      SUBROUTINE HESQR(N,NM,A,H,EVR,EVI,SUBDIA,INDIC,EPS,EX)
      DOUBLE PRECISION S,SR,SR2,X,Y,Z
      DIMENSION A(NM,1),H(NM,1),EVR(NM),EVI(NM),SUBDIA(NM)
      DIMENSION INDIC(NM)
      DATA I,J,K,L,M,MAXST,M1,NS/8*0/
      DATA S,SR,SR2,X,Y,Z/6*0.0D0/
      DATA SHIFT,T/2*0.0/
      IF(N-2)14,1,2
    1 SUBDIA(1) = A(2,1)
      GO TO 14
    2 M = N-2
      DO 12 K=1,M
      L = K+1
      S = 0.0
      DO 3 I=L,N
      H(I,K) = A(I,K)
    3 S = S + ABS(A(I,K))
      IF(S.NE.ABS(A(K+1,K))) GO TO 4
      SUBDIA(K) = A(K+1,K)
      H(K+1,K) = 0.0
      GO TO 12
    4 SR2 = 0.0
      DO 5 I=L,N
      SR = A(I,K)
      SR = SR/S
      A(I,K) = SR
    5 SR2 = SR2+SR*SR
      SR = DSQRT(SR2)
      IF(A(L,K).LT.0.0)GO TO 6
      SR = -SR
    6 SR2 = SR2-SR*A(L,K)
      A(L,K) = A(L,K)-SR
      H(L,K) = H(L,K)-SR*S
      SUBDIA(K) = SR*S
      X = S*DSQRT(SR2)
      DO 7 I=L,N
      H(I,K) = H(I,K)/X
    7 SUBDIA(I) = A(I,K)/SR2
      DO 9 J=L,N
      SR = 0.0
      DO 8 I=L,N
    8 SR = SR+A(I,K)*A(I,J)
      DO 9 I=L,N
    9 A(I,J) = A(I,J)-SUBDIA(I)*SR
      DO 11 J=1,N
      SR = 0.0
      DO 10 I=L,N
   10 SR = SR+A(J,I)*A(I,K)
      DO 11 I=L,N
   11 A(J,I) = A(J,I)-SUBDIA(I)*SR
   12 CONTINUE
      DO 13 K=1,M
   13 A(K+1,K) = SUBDIA(K)
         SUBDIA(N-1) = A(N,N-1)
   14 EPS = 0.0
      DO 15 K=1,N
      INDIC(K) = 0
      IF(K.NE.N)EPS = EPS+SUBDIA(K)**2
      DO 15 I=K,N
      H(K,I) = A(K,I)
   15 EPS = EPS + A(K,I)**2
      EPS = EX * SQRT(EPS)
      SHIFT = A(N,N-1)
      IF(N.LE.2)SHIFT = 0.0
      IF(A(N,N).NE.0.0) SHIFT = 0.0
      IF(A(N-1,N).NE.0.0)  SHIFT  = 0.0
      IF(A(N-1,N-1).NE.0.0) SHIFT = 0.0
      M = N
      NS = 0
      MAXST = N*10
      DO 16 I=2,N
      DO 16 K=I,N
      IF(A(I-1,K).NE.0.0)GO TO 18
   16 CONTINUE
      DO 17 I=1,N
      INDIC(I) = 1
      EVR(I) = A(I,I)
   17 EVI(I) = 0.0
      GO TO 37
   18 K=M-1
      M1=K
      I = K
      IF(K)37,34,19
   19 IF(ABS(A(M,K)).LE.EPS) GO TO 34
      IF(M-2.EQ.0)GO TO 35
   20 I = I-1
      IF(ABS(A(K,I)).LE.EPS) GO TO 21
      K = I
      IF(K.GT.1)GO TO 20
   21 IF(K.EQ.M1)GO TO 35
      S = A(M,M)+A(M1,M1)+SHIFT
      SR=A(M,M)*A(M1,M1)-A(M,M1)*A(M1,M)+0.25*SHIFT**2
      A(K+2,K) = 0.0
      X =A(K,K)*(A(K,K)-S)+A(K,K+1)*A(K+1,K)+SR
      Y = A(K+1,K)*(A(K,K)+A(K+1,K+1)-S)
      R=SNGL(DABS(X)+DABS(Y))
      IF (R .EQ. 0.) SHIFT=A(M,M-1)
      IF (R .EQ. 0.) GO TO 21
      Z = A(K+2,K+1)*A(K+1,K)
      SHIFT = 0.0
      NS = NS+1
      DO 33 I=K,M1
      IF(I.EQ.K)GO TO 22
      X = A(I,I-1)
      Y = A(I+1,I-1)
      Z = 0.0
      IF(I+2.GT.M)GO TO 22
      Z = A(I+2,I-1)
   22 SR2 = DABS(X)+DABS(Y)+DABS(Z)
      IF(SR2.EQ.0.0D+00) GO TO 23
      X = X/SR2
      Y = Y/SR2
      Z = Z/SR2
   23 S = DSQRT(X*X + Y*Y + Z*Z)
      IF(X.LT.0.0D+00)  GO TO 24
      S = -S
   24 IF(I.EQ.K)GO TO 25
      A(I,I-1) = S*SR2
   25 IF(SR2.NE.0.0D+00) GO TO 26
      IF(I+3.GT.M)GO TO 33
      GO TO 32
   26 SR = 1.0-X/S
      S = X-S
      X = Y/S
      Y = Z/S
      DO 28 J=I,M
      S = A(I,J)+A(I+1,J)*X
      IF(I+2.GT.M)GO TO 27
      S = S+A(I+2,J)*Y
   27 S = S*SR
      A(I,J) = A(I,J)-S
      A(I+1,J) = A(I+1,J)-S*X
      IF(I+2.GT.M)GO TO 28
      A(I+2,J) = A(I+2,J)-S*Y
   28 CONTINUE
      L = I+2
      IF(I.LT.M1)GO TO 29
      L = M
   29 DO 31 J=K,L
      S = A(J,I)+A(J,I+1)*X
      IF(I+2.GT.M)GO TO 30
      S = S + A(J,I+2)*Y
   30 S = S*SR
      A(J,I) = A(J,I)-S
      A(J,I+1)=A(J,I+1)-S*X
         IF(I+2 .GT. M) GO TO 31
      A(J,I+2)=A(J,I+2)-S*Y
   31 CONTINUE
      IF(I+3.GT.M)GO TO 33
      S = -A(I+3,I+2)*Y*SR
   32 A(I+3,I) = S
      A(I+3,I+1) = S*X
      A(I+3,I+2) = S*Y + A(I+3,I+2)
   33 CONTINUE
      IF(NS.GT.MAXST)GO TO 37
      GO TO 18
   34 EVR(M) = A(M,M)
      EVI(M) = 0.0
      INDIC(M) = 1
      M = K
      GO TO 18
   35 R = 0.5*(A(K,K) + A(M,M))
      S = 0.5*(A(M,M) - A(K,K))
      S = S*S + A(K,M)*A(M,K)
      INDIC(K) = 1
      INDIC(M) = 1
      IF(S.LT.0.0D+00) GO TO 36
      T = DSQRT(S)
      EVR(K) = R-T
      EVR(M) = R+T
      EVI(K) = 0.0
      EVI(M) = 0.0
      M = M-2
      GO TO 18
   36 T = DSQRT(-S)
      EVR(K) = R
      EVI(K) = T
      EVR(M) = R
      EVI(M) = -T
      M = M-2
      GO TO 18
   37 RETURN
      END
      SUBROUTINE REALVE(N,NM,M,IVEC,A,VECR,EVR,EVI,                     -
     1IWORK,WORK,INDIC,EPS,EX)
      DOUBLE PRECISION S,SR
      DIMENSION A(NM,1),VECR(NM,1),EVR(NM)
      DIMENSION EVI(NM),IWORK(NM),WORK(NM),INDIC(NM)
      DATA S,SR,I,     ITER,J,K,L,NS,BOUND,EVALUE,PREVIS,R,R1,T/        -
     12*0.0D0,6*0,6*0.0/
      VECR(1,IVEC) = 1.0
      IF(M.EQ.1)GO TO 24
      EVALUE = EVR(IVEC)
      IF(IVEC.EQ.M)GO TO 2
      K = IVEC+1
      R = 0.0
      DO 1 I=K,M
      IF(EVALUE.NE.EVR(I))GO TO 1
      IF(EVI(I).NE.0.0) GO TO 1
      R = R+3.0
    1 CONTINUE
      EVALUE = EVALUE+R*EX
    2 DO 3 K=1,M
    3 A(K,K) = A(K,K)-EVALUE
      K = M-1
      DO 8 I=1,K
      L = I+1
      IWORK(I) = 0
      IF(A(I+1,I).NE.0.0)  GO TO 4
      IF(A(I,I ).NE.0.0)   GO TO 8
      A(I,I) = EPS
      GO TO 8
    4 IF(ABS(A(I,I)).GT.ABS(A(I+1,I))) GO TO 6
      IWORK(I) = 1
      DO 5 J=I,M
      R = A(I,J)
      A(I,J) = A(I+1,J)
    5 A(I+1,J) = R
    6 R = -A(I+1,I)/A(I,I)
      A(I+1,I) = R
      DO 7 J=L,M
    7 A(I+1,J) = A(I+1,J)+R*A(I,J)
    8 CONTINUE
      IF(A(M,M).NE.0.0)  GO TO 9
      A(M,M) = EPS
    9 DO 11 I = 1,N
      IF(I.GT.M)GO TO 10
      WORK(I) = 1.0
      GO TO 11
   10 WORK(I) = 0.0
   11 CONTINUE
      BOUND = 0.01 / (EX * FLOAT(N))
      NS = 0
      ITER = 1
   12 R = 0.0
      DO 15 I=1,M
      J = M-I+1
      S = WORK(J)
         IF(J .EQ. M) GO TO 14
      L = J+1
      DO 13 K=L,M
      SR = WORK(K)
   13 S = S - SR*A(J,K)
   14 WORK(J) = S/A(J,J)
      T = ABS(WORK(J))
      IF(R.GE.T)GO TO 15
      R = T
   15 CONTINUE
      DO 16 I=1,M
   16 WORK(I) = WORK(I)/R
      R1 = 0.0
      DO 18 I=1,M
      T = 0.0
      DO 17 J=I,M
   17 T = T+A(I,J)*WORK(J)
      T = ABS (T)
      IF(R1.GE.T)GO TO 18
      R1 = T
   18 CONTINUE
      IF(ITER.EQ.1)GO TO 19
      IF(PREVIS.LE.R1)GO TO 24
   19 DO 20 I=1,M
   20 VECR(I,IVEC) = WORK(I)
      PREVIS = R1
      IF(NS.EQ.1)GO TO 24
      IF(ITER.GT.6)GO TO 25
      ITER = ITER+1
      IF(R.LT.BOUND)GO TO 21
      NS = 1
   21 K = M-1
      DO 23 I=1,K
      R = WORK(I+1)
      IF(IWORK(I).EQ.0)GO TO 22
      WORK(I+1)=WORK(I)+WORK(I+1)*A(I+1,I)
      WORK(I) = R
      GO TO 23
   22 WORK(I+1)=WORK(I+1)+WORK(I)*A(I+1,I)
   23 CONTINUE
      GO TO 12
   24 INDIC(IVEC) = 2
   25 IF(M.EQ.N)GO TO 27
      J = M+1
      DO 26 I=J,N
   26 VECR(I,IVEC) = 0.0
   27 RETURN
      END
      SUBROUTINE COMPVE(N,NM,M,IVEC,A,VECR,H,EVR,EVI,INDIC,             -
     1IWORK,SUBDIA,WORK1,WORK2,WORK,EPS,EX)
      DOUBLE PRECISION D,D1
      DIMENSION A(NM,1),VECR(NM,1),H(NM,1),EVR(NM),EVI(NM),             -
     1INDIC(NM),IWORK(NM),SUBDIA(NM),WORK1(NM),WORK2(NM),               -
     2WORK(NM)
      DATA D,D1,I,I1,I2,ITER,J,K,L,NS,B,BOUND,ETA,FKSI,PREVIS,R,S,U,V/  -
     12*0.0D0,8*0,9*0.0/
      FKSI = EVR(IVEC)
      ETA = EVI(IVEC)
      IF(IVEC.EQ.M)GO TO 2
      K = IVEC+1
      R = 0.0
      DO 1 I=K,M
      IF(FKSI.NE.EVR(I))GO TO 1
      IF(ABS(ETA).NE.ABS(EVI(I)))  GO TO 1
      R = R + 3.0
    1 CONTINUE
      R = R*EX
      FKSI = FKSI+R
      ETA = ETA + R
    2 R = FKSI*FKSI + ETA*ETA
      S = 2.0*FKSI
      L = M-1
      DO 5 I=1,M
      DO 4 J=I,M
      D = 0.0
      A(J,I) = 0.0
      DO 3 K = I,J
    3 D = D+H(I,K)*H(K,J)
    4 A(I,J) = D-S*H(I,J)
    5 A(I,I) = A(I,I)+R
      DO 9 I=1,L
      R = SUBDIA(I)
      A(I+1,I) = -S*R
      I1 = I+1
      DO 6 J=1,I1
    6 A(J,I) = A(J,I)+R*H(J,I+1)
      IF(I.EQ.1)GO TO 7
      A(I+1,I-1) = R*SUBDIA(I-1)
    7 DO 8 J=I,M
    8 A(I+1,J) = A(I+1,J)+R*H(I,J)
    9 CONTINUE
      K = M-1
      DO 18 I=1,K
      I1 = I+1
      I2 = I+2
      IWORK(I) = 0
      IF(I.EQ.K)GO TO 10
      IF(A(I+2,I).NE.0.0)GO TO 11
   10 IF(A(I+1,I).NE.0.0)GO TO 11
      IF(A(I,I).NE.0.0)GO TO 18
      A(I,I) = EPS
      GO TO 18
   11 IF(I.EQ.K)GO TO 12
      IF(ABS(A(I+1,I)).GE.ABS(A(I+2,I))) GO TO 12
      IF(ABS(A(I,I )).GE.ABS(A(I+2,I)))  GO TO 16
      L = I+2
      IWORK(I) = 2
      GO TO 13
   12 IF(ABS(A(I,I)).GT.ABS(A(I+1,I)))   GO TO 15
      L = I+1
      IWORK(I) = 1
   13 DO 14 J=I,M
      R = A(I,J)
      A(I,J) = A(L,J)
   14 A(L,J) = R
   15 IF(I.NE.K)GO TO 16
      I2 = I1
   16 DO 17 L=I1,I2
      R = -A(L,I)/A(I,I)
      A(L,I) = R
      DO 17 J=I1,M
   17 A(L,J) = A(L,J)+R*A(I,J)
   18 CONTINUE
      IF(A(M,M).NE.0.0) GO TO 19
      A(M,M) = EPS
   19 DO 21 I=1,N
      IF(I.GT.M)GO TO 20
      VECR(I,IVEC) = 1.0
      VECR(I,IVEC-1) = 1.0
      GO TO 21
   20 VECR(I,IVEC) = 0.0
      VECR(I,IVEC-1) = 0.0
   21 CONTINUE
      BOUND = 0.01 / (EX * FLOAT(N))
      NS = 0
      ITER = 1
      DO 22 I=1,M
   22 WORK(I) = H(I,I)-FKSI
   23 DO 27 I=1,M
      D = WORK(I)*VECR(I,IVEC)
      IF(I.EQ.1)GO TO 24
      D = D+SUBDIA(I-1)*VECR(I-1,IVEC)
   24 L = I+1
      IF(L.GT.M)GO TO 26
      DO 25 K=L,M
   25 D = D+H(I,K)*VECR(K,IVEC)
   26 VECR(I,IVEC-1) = D-ETA*VECR(I,IVEC-1)
   27 CONTINUE
      K = M-1
      DO 28 I=1,K
      L = I+IWORK(I)
      R = VECR(L,IVEC-1)
      VECR(L,IVEC-1) = VECR(I,IVEC-1)
      VECR(I,IVEC-1) = R
      VECR(I+1,IVEC-1) = VECR(I+1,IVEC-1)+A(I+1,I)*R
      IF(I.EQ.K)GO TO 28
      VECR(I+2,IVEC-1) = VECR(I+2,IVEC-1)+A(I+2,I)*R
   28 CONTINUE
      DO 31 I=1,M
      J = M-I+1
      D = VECR(J,IVEC-1)
      IF(J.EQ.M)GO TO 30
      L = J+1
      DO 29 K=L,M
      D1 = A(J,K)
   29 D = D-D1*VECR(K,IVEC-1)
   30 VECR(J,IVEC-1) = D/A(J,J)
   31 CONTINUE
      DO 35 I=1,M
      D = WORK(I)*VECR(I,IVEC-1)
      IF(I.EQ.1)GO TO 32
      D = D+SUBDIA(I-1)*VECR(I-1,IVEC-1)
   32 L = I+1
      IF(L.GT.M)GO TO 34
      DO 33 K=L,M
   33 D = D+H(I,K)*VECR(K,IVEC-1)
   34 VECR(I,IVEC) = (VECR(I,IVEC)-D)/ETA
   35 CONTINUE
      L = 1
      S = 0.0
      DO 36 I=1,M
      R = VECR(I,IVEC)**2 + VECR(I,IVEC-1)**2
      IF(R.LE.S)GO TO 36
      S = R
      L = I
   36 CONTINUE
      U = VECR(L,IVEC-1)
      V = VECR(L,IVEC)
      DO 37 I=1,M
      B = VECR(I,IVEC)
      R = VECR(I,IVEC-1)
      VECR(I,IVEC) = (R*U + B*V)/S
   37 VECR(I,IVEC-1) = (B*U-R*V)/S
      B = 0.0
      DO 41 I=1,M
      R = WORK(I)*VECR(I,IVEC-1) - ETA*VECR(I,IVEC)
      U = WORK(I)*VECR(I,IVEC) + ETA*VECR(I,IVEC-1)
      IF(I.EQ.1)GO TO 38
      R = R+SUBDIA(I-1)*VECR(I-1,IVEC-1)
      U = U+SUBDIA(I-1)*VECR(I-1,IVEC)
   38 L = I+1
      IF(L.GT.M)GO TO 40
      DO 39 J=L,M
      R = R+H(I,J)*VECR(J,IVEC-1)
   39 U = U+H(I,J)*VECR(J,IVEC)
   40 U = R*R + U*U
      IF(B.GE.U)GO TO 41
      B = U
   41 CONTINUE
      IF(ITER.EQ.1)GO TO 42
      IF(PREVIS.LE.B)GO TO 44
   42 DO 43 I=1,N
      WORK1(I) = VECR(I,IVEC)
   43 WORK2(I) = VECR(I,IVEC-1)
      PREVIS = B
      IF(NS.EQ.1)GO TO 46
      IF(ITER.GT.6)GO TO 47
      ITER = ITER+1
      IF(BOUND.GT.SQRT(5)) GO TO 23
      NS = 1
      GO TO 23
   44 DO 45 I=1,N
      VECR(I,IVEC) = WORK1(I)
   45 VECR(I,IVEC-1)=WORK2(I)
   46 INDIC(IVEC-1) = 2
      INDIC(IVEC) = 2
   47 RETURN
      END
      SUBROUTINE RTRII(OPREAD,DEBUG,VTIP,T75,T1C,T1S,DENSE,CSOUND,OPUNIT-
     1)
      INTEGER OPREAD,DEBUG,OPUNIT
      COMMON /RINPUT/TYPE,NBLADE,DEL3G,NTRIM0,NTRIM1,MU,LAMDA,MTIP,NBM,N-
     1TM,GIMBAL,GAMMA,OMEGA,RADIUS,SIGMA,OPAERO,MRAERO,BBLD,RROOT,INCOMP-
     2,TRC,TRS,TR0,MPSI,MREV,OPMODE,OFFSET,MRMODE,NONROT,NCOLB,CONE,IB,D-
     3EL1,XFA,KPG,GGS,GQS(5),GPS(3),NCOLT,WT0,RFA,HSPRC,HSPRS,KPB(5),RPH-
     4,XPH,WTC,WTS,WTR,WTCH,WTSH,WTRH,NUGC,NUGS,KFLAP,KLAG,HINGE,KPIN,AT-
     5ANKP(5),DROOP,SWEEP,DEL2,DEL3,ZFA,VTIPN,DEBUGR,EPMODE,GLAG,LDAMP,E-
     6XDAMP,PHIPH,PHIPL,LDAMPC,MUY,MUZ,CHORD(51),XA(51),MASS(51),XI(51),-
     7THETA(51),ITHETA(51),TWIST(51),EIZZ(51),EIXX(51),GJ(51),XC(51),DEN-
     8SER,OPUNIR,ELAG,VTOT,KHLMDA,KFLMDA,ALFHP,PSIHP,T75IN,T1CIN,T1SIN,I-
     9RING,ROTATE,FDROOP,FSWEEP,DEL4,DEL5
      REAL MU,LAMDA,MTIP,IB,MASS,ITHETA,KPG,NUGC,NUGS,KPB,KFLAP,KLAG,LDA-
     1MP,LDAMPC,MUY,MUZ,KHLMDA,KFLMDA
      INTEGER OPAERO,GIMBAL,OPMODE,HINGE,DEBUGR,OPUNIR,ROTATE
C  COMMON/RINPUT/ VARIANCES:   WTCH/WTC,WTSH/WTS,WTRH/WTR
C                              T1C->TRC,T1S->TRS,T75->TR0
      COMMON /MODES/ETA(5,2,51),ETAP(5,2,51),ETAPP(5,2,51),NU(5),ZETA(3,-
     151),ZETAP(3,51),WT(3),EFA(5,2),EFAP(5,2),EFAPP(5,2)
      REAL NU
      NAMELIST /NLRTR/TYPE,GAMMA,SIGMA,NBLADE,IB,RADIUS,OMEGA,GIMBAL,DEN-
     1SER,ROTATE,NBM,NTM,BBLD,RROOT,TR0,TRC,TRS,VTIPN,MU,MUY,MUZ,LAMDA,K-
     2HLMDA,KFLMDA,MTIP,OPAERO,OPMODE,NONROT,INCOMP,DEBUGR,NTRIM0,NTRIM1-
     3,MRAERO,MRMODE,EPMODE,MREV,MPSI,                                  -
     4                           HINGE,OFFSET,ELAG,NU,WT0,NUGC,NUGS,WTCH-
     5,WTSH,WTRH,WTC,WTS,WTR,KFLAP,KLAG,HSPRC,HSPRS,NCOLB,NCOLT,LDAMP,EX-
     6DAMP,LDAMPC,GLAG,GGS,GQS,GPS,KPIN,ATANKP,DEL3G,KPB,KPG,RPH,XPH,PHI-
     7PL,PHIPH,CONE,DROOP,SWEEP,FDROOP,FSWEEP,DEL1,DEL2,DEL3,DEL4,DEL5,R-
     8FA,XFA,ZFA,CHORD,XA,MASS,XI,XC,THETA,TWIST,ITHETA,EIXX,EIZZ,GJ
      DATA CVERT/57.29578/
      IF ((OPREAD .EQ. 1) .OR. (OPREAD .EQ. 3)) READ(5,NLRTR)
      DENSER=DENSE
      OPUNIR=OPUNIT
      IF (IABS(ROTATE) .NE. 1) ROTATE=1
      OMEGA=VTIP/RADIUS
      MTIP=0.
      IF (INCOMP .NE. 0) MTIP=VTIP/CSOUND
      OR=VTIPN/VTIP
      NUGC=SQRT(1.+HSPRC*OR*OR)
      NUGS=SQRT(1.+HSPRS*OR*OR)
      IF (NBLADE .EQ. 2) NUGS=NUGC
      WTCH=WTC*OR
      WTSH=WTS*OR
      WTRH=WTR*OR
      WT(1)=WT0*OR
      IF ((OPMODE .NE. 4) .OR. (ELAG .EQ. 0.)) ELAG=OFFSET
      LDAMPC=LDAMP/OR**EXDAMP
      GLAG=LDAMPC/(IB*OMEGA)
      TR0=T75
      TRC=T1C/CVERT
      TRS=T1S/CVERT
      DO 23 JR=1,51
   23 THETA(JR)=(T75+TWIST(JR))/CVERT
      T75IN=.5*(THETA(38)+THETA(39))*CVERT
      T1CIN=T1C
      T1SIN=T1S
      DEL1=CONE/CVERT
      CS=COS(T75/CVERT)
      SN=SIN(T75/CVERT)
      DEL2=(FDROOP+(DROOP-FDROOP)*CS+(SWEEP-FSWEEP)*SN)/CVERT
      DEL3=(FSWEEP-(DROOP-FDROOP)*SN+(SWEEP-FSWEEP)*CS)/CVERT
      DEL4=FDROOP/CVERT
      DEL5=FSWEEP/CVERT
      DEBUGR=0
      IF (DEBUG .EQ. 3) DEBUGR=1
      IF (DEBUG .GE. 2) WRITE(6,NLRTR)
      RETURN
      END
      SUBROUTINE REQROT
      COMMON /RCOEF/A2(30,30),A1(30,30),A0(30,30),AA2(30,6),AA1(30,6),AA-
     10(30,6),B(30,8),BG(30,3),C2(6,30),C1(6,30),C0(6,30),CA2(6,6),CA1(6-
     2,6),CA0(6,6),DG(6,3)
      DO 1 I=1,30
      AA2(I,2)=-AA2(I,2)
      AA2(I,4)=-AA2(I,4)
      AA2(I,6)=-AA2(I,6)
      AA1(I,2)=-AA1(I,2)
      AA1(I,4)=-AA1(I,4)
      AA1(I,6)=-AA1(I,6)
      AA0(I,2)=-AA0(I,2)
      AA0(I,4)=-AA0(I,4)
    1 AA0(I,6)=-AA0(I,6)
      DO 2 I=1,6
      CA2(I,2)=-CA2(I,2)
      CA2(I,4)=-CA2(I,4)
      CA2(I,6)=-CA2(I,6)
      CA1(I,2)=-CA1(I,2)
      CA1(I,4)=-CA1(I,4)
      CA1(I,6)=-CA1(I,6)
      CA0(I,2)=-CA0(I,2)
      CA0(I,4)=-CA0(I,4)
    2 CA0(I,6)=-CA0(I,6)
      DO 3 I=1,30
      C2(3,I)=-C2(3,I)
      C2(4,I)=-C2(4,I)
      C2(6,I)=-C2(6,I)
      C1(3,I)=-C1(3,I)
      C1(4,I)=-C1(4,I)
      C1(6,I)=-C1(6,I)
      C0(3,I)=-C0(3,I)
      C0(4,I)=-C0(4,I)
    3 C0(6,I)=-C0(6,I)
      DO 4 I=1,6
      CA2(3,I)=-CA2(3,I)
      CA2(4,I)=-CA2(4,I)
      CA2(6,I)=-CA2(6,I)
      CA1(3,I)=-CA1(3,I)
      CA1(4,I)=-CA1(4,I)
      CA1(6,I)=-CA1(6,I)
      CA0(3,I)=-CA0(3,I)
      CA0(4,I)=-CA0(4,I)
    4 CA0(6,I)=-CA0(6,I)
      DO 5 I=1,3
      DG(3,I)=-DG(3,I)
      DG(4,I)=-DG(4,I)
    5 DG(6,I)=-DG(6,I)
      DO 6 I=1,30
    6 BG(I,2)=-BG(I,2)
      DO 7 I=1,6
    7 DG(I,2)=-DG(I,2)
      RETURN
      END
      SUBROUTINE ROTOR0
      COMMON /RINPUT/TYPE,NBLADE,DEL3G,NTRIM0,NTRIM1,MU,LAMDA,MTIP,NBM,N-
     1TM,GIMBAL,GAMMA,OMEGA,RADIUS,SIGMA,OPAERO,MRAERO,BBLD,RROOT,INCOMP-
     2,T1C,T1S,T75,MPSI,MREV,OPMODE,OFFSET,MRMODE,NONROT,NCOLB,CONE,IB,D-
     3EL1,XFA,KPG,GGS,GQS(5),GPS(3),NCOLT,WT0,RFA,HSPRC,HSPRS,KPB(5),RPH-
     4,XPH,WTCH,WTSH,WTRH,WTC,WTS,WTR,NUGC,NUGS,KFLAP,KLAG,HINGE,KPIN,AT-
     5ANKP(5),DROOP,SWEEP,DEL2,DEL3,ZFA,VTIPN,DEBUGR,EPMODE,GLAG,LDAMP,E-
     6XDAMP,PHIPH,PHIPL,LDAMPC,MUY,MUZ,CHORD(51),XA(51),MASS(51),XI(51),-
     7THETA(51),ITHETA(51),TWIST(51),EIZZ(51),EIXX(51),GJ(51),XC(51),DEN-
     8SER,OPUNIR,ELAG,VTOT,KHLMDA,KFLMDA,ALFHP,PSIHP,T75IN,T1CIN,T1SIN,I-
     9RING,ROTATE,FDROOP,FSWEEP,DEL4,DEL5
      REAL MU,LAMDA,MTIP,IB,MASS,ITHETA,KPG,NUGC,NUGS,KPB,KFLAP,KLAG,LDA-
     1MP,LDAMPC,MUY,MUZ,KHLMDA,KFLMDA
      INTEGER OPAERO,GIMBAL,OPMODE,HINGE,DEBUGR,OPUNIR,ROTATE
      COMMON /MODES/ETA(5,2,51),ETAP(5,2,51),ETAPP(5,2,51),NU(5),ZETA(3,-
     151),ZETAP(3,51),WT(3),EFA(5,2),EFAP(5,2),EFAPP(5,2)
      REAL NU
      COMMON /BAERO/MQU(5),MQDZ(5),MQZ(5),MQL(5),MQDB(5),MQB(5),MQDQ(5,5-
     1),MQQ(5,5),MQP(5,3),MMU,MDZ,MZ,ML,MDB,MB,MDQ(5),MQ(5),MP(3),TU,TDZ-
     2,TZ,TL,TDB,TB,TDQ(5),TQ(5),TP(3),HU,HDZ,HZ,HL,HDB,HB,HDQ(5),HQ(5),-
     3HP(3),QU,QDZ,QZ,QL,QDB,QB,QDQ(5),QQ(5),QP(3),RR,RU,RDZ,RZ,RL,RDB,R-
     4B,RDQ(5),RQ(5),RP(3),MPU(3),MPDZ(3),MPZ(3),MPL(3),MPDB(3),MPB(3),M-
     5PDQ(3,5),MPQ(3,5),MPP(3,3),MPDP(3,3),FZ0,FX0
      REAL MQU,MQDZ,MQZ,MQL,MQDB,MQB,MQDQ,MQQ,MQP,MMU,MDZ,MZ,ML,MDB,MB,M-
     1DQ,MQ,MP,MPU,MPDZ,MPZ,MPL,MPDB,MPB,MPDQ,MPQ,MPP,MPDP
      COMMON /BINERT/   I0,SQ(5,2),IQA(5,2),SPA(3,2),IDQA(5),IDQP(5),IQ(-
     15),SQDDP(5,3),SQP(5,3),IQDQ(5,5),IP(3),SP(3,2),IPA(3,2),SPDDA(3),S-
     2PDDQ(3,5),SPQ(3,5),IPDDP(3,3),IPP(3,3),XATOR(3,2,51),DXATOR(3,5,2,-
     351),MASSB,IQDP(5),IDQA0
      REAL MASSB,I0,IQA,IDQA,IDQP,IQ,IQDQ,IP,IPA,IPDDP,IPP,IQDP,IDQA0
      COMMON /RCOEF/A2(30,30),A1(30,30),A0(30,30),AA2(30,6),AA1(30,6),AA-
     10(30,6),B(30,8),BG(30,3),C2(6,30),C1(6,30),C0(6,30),CA2(6,6),CA1(6-
     2,6),CA0(6,6),DG(6,3)
      DIMENSION ZERO(4236)
      EQUIVALENCE (ZERO(1),A2(1,1))
      INTEGER EVEN,CROSS
      EVEN=0
      IF (NBLADE/2*2 .EQ. NBLADE) EVEN=1
      CROSS=(NBLADE-1)/2
      DO 1 I=1,4236
    1 ZERO(I)=0.
      PSIM=0.
      CALL INERT(PSIM)
      IRE=IFIX(ELAG*50.)+2
      DO 11 K=1,NBM
      C=IQ(K)
      DC=C*GQS(K)*NU(K)
      DO 12 J=1,NBLADE
      K1=(K-1)*NBLADE+J
      IF (K1 .GT. 15) GO TO 12
      A2(K1,K1)=C
      A1(K1,K1)=DC
      A0(K1,K1)=C*(NU(K)**2-FLOAT(J/2)**2)
      IF ((J .EQ. NBLADE) .AND. (EVEN .EQ. 1)) A0(K1,K1)=C*NU(K)**2
   12 CONTINUE
      DO 211 J=1,CROSS
      K1=(K-1)*NBLADE+2*J+1
      IF (K1 .GT. 15) GO TO 211
      A1(K1,K1-1)=-2.*FLOAT(J)*C
      A1(K1-1,K1)=2.*FLOAT(J)*C
      A0(K1-1,K1)=FLOAT(J)*DC
      A0(K1,K1-1)=-FLOAT(J)*DC
  211 CONTINUE
      DO 13 I=1,NBM
      C=IQDQ(K,I)+.5*GLAG*ETAP(K,2,IRE)*ETAP(I,2,IRE)
      DO 14 J=1,NBLADE
      K1=(K-1)*NBLADE+J
      I1=(I-1)*NBLADE+J
      IF ((K1 .GT. 15) .OR. (I1 .GT. 15)) GO TO 14
      A1(K1,I1)=A1(K1,I1)+2.*C
   14 CONTINUE
      DO 13 J=1,CROSS
      K1=(K-1)*NBLADE+2*J+1
      I1=(I-1)*NBLADE+2*J+1
      IF ((K1 .LE. 15) .AND. (I1 .LE. 16)) A0(K1,I1-1)=A0(K1,I1-1)-2.*FL-
     1OAT(J)*C
      IF ((K1 .LE. 16) .AND. (I1 .LE. 15)) A0(K1-1,I1)=A0(K1-1,I1)+2.*FL-
     1OAT(J)*C
   13 CONTINUE
      DO 15 I=1,NTM
      C=SQP(K,I)
      DDC=SQDDP(K,I)
      DO 16 J=1,NBLADE
      K1=(K-1)*NBLADE+J
      I1=(I-1)*NBLADE+J+15
      IF ((K1 .GT. 15) .OR. (I1 .GT. 24)) GO TO 16
      A2(K1,I1)=-DDC
      A0(K1,I1)=-C+DDC*FLOAT(J/2)**2
      IF ((J .EQ. NBLADE) .AND. (EVEN .EQ. 1)) A0(K1,I1)=-C
   16 CONTINUE
      DO 15 J=1,CROSS
      K1=(K-1)*NBLADE+2*J+1
      I1=(I-1)*NBLADE+2*J+16
      IF ((K1 .LE. 15) .AND. (I1 .LE. 25)) A1(K1,I1-1)=2.*FLOAT(J)*DDC
      IF ((K1 .LE. 16) .AND. (I1 .LE. 24)) A1(K1-1,I1)=-2.*FLOAT(J)*DDC
   15 CONTINUE
      K1=(K-1)*NBLADE+3
      C=IQA(K,1)
      IF (GIMBAL .EQ. 0) GO TO 17
      IF (K1 .GT. 16) GO TO 17
      A2(K1-1,25)=C
      A1(K1-1,26)=2.*C
      A2(K1-1,26)=-IDQA(K)
      IF (K1 .GT. 15) GO TO 17
      A2(K1,26)=C
      A1(K1,25)=-2.*C
      A2(K1,25)=IDQA(K)
   17 IF (K1 .GT. 17) GO TO 11
      A2(K1-2,27)=IQA(K,2)
      AA2(K1-2,6)=IQA(K,2)
      A1(K1-2,27)=2.*IQDP(K)
      AA1(K1-2,6)=2.*IQDP(K)
      AA2(K1-2,3)=SQ(K,1)
      IF (K1 .GT. 16) GO TO 11
      AA2(K1-1,2)=SQ(K,2)
      AA2(K1-1,5)=-C
      AA1(K1-1,4)=2.*C
      IF (K1 .GT. 15) GO TO 11
      AA2(K1,1)=-SQ(K,2)
      AA2(K1,4)=C
      AA1(K1,5)=2.*C
   11 CONTINUE
      DO 18 K=1,NTM
      DO 19 I=1,NBM
      C=SPQ(K,I)
      DDC=SPDDQ(K,I)
      DO 20 J=1,NBLADE
      K1=(K-1)*NBLADE+J+15
      I1=(I-1)*NBLADE+J
      IF ((K1 .GT. 24) .OR. (I1 .GT. 15)) GO TO 20
      A2(K1,I1)=-DDC
      A0(K1,I1)=-C+DDC*FLOAT(J/2)**2
      IF ((J .EQ. NBLADE) .AND. (EVEN .EQ. 1)) A0(K1,I1)=-C
      IF (K .NE. 1) GO TO 20
      WTORS=WT(1)
      IF (J .EQ. 2) WTORS=WTC
      IF (J .EQ. 3) WTORS=WTS
      IF (J .GE. 4) WTORS=WTR
      A0(K1,I1)=A0(K1,I1)+KPB(I)*IP(1)*WTORS**2
   20 CONTINUE
      DO 19 J=1,CROSS
      K1=(K-1)*NBLADE+2*J+16
      I1=(I-1)*NBLADE+2*J+1
      IF ((K1 .LE. 24) .AND. (I1 .LE. 16)) A1(K1,I1-1)=2.*FLOAT(J)*DDC
      IF ((K1 .LE. 25) .AND. (I1 .LE. 15)) A1(K1-1,I1)=-2.*FLOAT(J)*DDC
   19 CONTINUE
      C=IP(K)
      DC=C*GPS(K)*WT(K)
      DO 21 J=1,NBLADE
      K1=(K-1)*NBLADE+J+15
      IF (K1 .GT. 24) GO TO 21
      WTORS=WT(K)
      IF ((K .EQ. 1) .AND. (J .EQ. 2)) WTORS=WTC
      IF ((K .EQ. 1) .AND. (J .EQ. 3)) WTORS=WTS
      IF ((K .EQ. 1) .AND. (J .GE. 4)) WTORS=WTR
      A2(K1,K1)=C
      A1(K1,K1)=DC
      A0(K1,K1)=C*(WTORS**2-FLOAT(J/2)**2)
      IF ((J .EQ. NBLADE) .AND. (EVEN .EQ. 1)) A0(K1,K1)=C*WTORS**2
      IF ((K .EQ. 1) .AND. (J .LE. 8)) B(K1,J)=C*WTORS**2
   21 CONTINUE
      DO 212 J=1,CROSS
      K1=(K-1)*NBLADE+2*J+16
      IF (K1 .GT. 24) GO TO 212
      A1(K1,K1-1)=-2.*FLOAT(J)*C
      A1(K1-1,K1)=2.*FLOAT(J)*C
      A0(K1,K1-1)=-FLOAT(J)*DC
      A0(K1-1,K1)=FLOAT(J)*DC
  212 CONTINUE
      DO 22 I=1,NTM
      C=IPP(K,I)
      DDC=IPDDP(K,I)
      DO 23 J=1,NBLADE
      K1=(K-1)*NBLADE+J+15
      I1=(I-1)*NBLADE+J+15
      IF ((K1 .GT. 24) .OR. (I1 .GT. 24)) GO TO 23
      A2(K1,I1)=A2(K1,I1)+DDC
      A0(K1,I1)=A0(K1,I1)+C-DDC*FLOAT(J/2)**2
      IF ((J .EQ. NBLADE) .AND. (EVEN .EQ. 1)) A0(K1,I1)=A0(K1,I1)+DDC*F-
     1LOAT(J/2)**2
   23 CONTINUE
      DO 22 J=1,CROSS
      K1=(K-1)*NBLADE+2*J+16
      I1=(I-1)*NBLADE+2*J+16
      IF ((K1 .LE. 24) .AND. (I1 .LE. 25)) A1(K1,I1-1)=A1(K1,I1-1)-2.*FL-
     1OAT(J)*DDC
      IF ((K1 .LE. 25) .AND. (I1 .LE. 24)) A1(K1-1,I1)=A1(K1-1,I1)+2.*FL-
     1OAT(J)*DDC
   22 CONTINUE
      K1=(K-1)*NBLADE+18
      IF (GIMBAL .EQ. 0) GO TO 24
      C=IPA(K,2)
      IF (K1 .GT. 25) GO TO 24
      A2(K1-1,25)=-C
      A2(K1-1,26)=-SPDDA(K)
      A1(K1-1,26)=-2.*C
      IF (K .EQ. 1) A0(K1-1,25)=KPG*IP(1)*WTC**2
      IF (K1 .GT. 24) GO TO 24
      A2(K1,26)=-C
      A2(K1,25)=SPDDA(K)
      A1(K1,25)=2.*C
      IF (K .EQ. 1) A0(K1,26)=KPG*IP(1)*WTS**2
   24 C=IPA(K,2)
      IF (K1 .GT. 26) GO TO 18
      IF (K .EQ. 1) A0(17,27)=-IP(1)*WTC**2*T1S
      IF (K .EQ. 1) A0(18,27)= IP(1)*WTS**2*T1C
      A2(K1-2,27)=IPA(K,1)
      AA2(K1-2,3)=-SP(K,2)
      AA2(K1-2,6)=IPA(K,1)
      IF (K1 .GT. 25) GO TO 18
      AA2(K1-1,2)=SP(K,1)
      AA2(K1-1,5)=C
      AA1(K1-1,4)=-2.*C
      IF (K1 .GT. 24) GO TO 18
      AA2(K1,1)=-SP(K,1)
      AA2(K1,4)=-C
      AA1(K1,5)=-2.*C
   18 CONTINUE
      IF (GIMBAL .EQ. 0) GO TO 25
      DO 26 I=1,NBM
      I1=(I-1)*NBLADE+3
      C=IQA(I,1)
      DC=IDQA(I)
      IF (I1 .GT. 16) GO TO 26
      A2(25,I1-1)=C
      A1(26,I1-1)=-2.*C
      A1(25,I1-1)=2.*DC
      A0(26,I1-1)=-2.*DC
      IF (I1 .GT. 15) GO TO 26
      A2(26,I1)=C
      A1(25,I1)=2.*C
      A1(26,I1)=2.*DC
      A0(25,I1)=2.*DC
   26 CONTINUE
      DO 27 I=1,NTM
      I1=(I-1)*NBLADE+18
      C=SPA(I,1)
      IF (I1 .GT. 25) GO TO 27
      A2(25,I1-1)=-C
      A1(26,I1-1)=2.*C
      IF (I1 .GT. 24) GO TO 27
      A2(26,I1)=-C
      A1(25,I1)=-2.*C
   27 CONTINUE
      A2(25,25)=I0
      A2(26,26)=I0
      A1(25,25)=I0*GGS*SQRT(NUGC**2-.999)
      A1(25,26)=2.*I0
      A1(26,25)=-2.*I0
      A1(26,26)=I0*GGS*SQRT(NUGS**2-.999)
      A0(25,25)=(NUGC**2-1.)*I0
      A0(26,26)=(NUGS**2-1.)*I0
      AA2(25,5)=-I0
      AA2(26,4)=I0
      AA1(25,4)=2.*I0
      AA1(26,5)=2.*I0
   25 CONTINUE
      DO 128 I=1,NBM
      I1=(I-1)*NBLADE+1
      IF (I1 .GT. 15) GO TO 128
      A2(27,I1)=IQA(I,2)
      A1(27,I1)=-2.*IDQP(I)
  128 CONTINUE
      DO 129 I=1,NTM
      I1=(I-1)*NBLADE+16
      IF (I1 .GT. 24) GO TO 129
      A2(27,I1)=-SPA(I,2)
  129 CONTINUE
      A2(27,27)=I0
      AA2(27,6)=I0
      DO 28 I=1,NBM
      I1=(I-1)*NBLADE+3
      C=SQ(I,2)
      DC=IQA(I,1)
      DDC=IDQA(I)
      IF (I1 .GT. 17) GO TO 28
      C2(1,I1-2)=-SQ(I,1)
      C2(4,I1-2)=IQA(I,2)
      C1(4,I1-2)=-2.*IDQP(I)
      IF (I1 .GT. 16) GO TO 28
      C2(3,I1-1)=C
      C2(5,I1-1)=DC
      C1(6,I1-1)=-2.*DC
      C1(5,I1-1)=2.*DDC
      C0(6,I1-1)=-2.*DDC
      IF (I1 .GT. 15) GO TO 28
      C2(2,I1)=C
      C2(6,I1)=DC
      C1(5,I1)=2.*DC
      C1(6,I1)=2.*DDC
      C0(5,I1)=2.*DDC
   28 CONTINUE
      DO 29 I=1,NTM
      I1=(I-1)*NBLADE+18
      C=SPA(I,1)
      IF (I1 .GT. 26) GO TO 29
      C2(4,I1-2)=-SPA(I,2)
      IF (I1 .GT. 25) GO TO 29
      C2(5,I1-1)=-C
      C1(6,I1-1)=2.*C
      IF (I1 .GT. 24) GO TO 29
      C2(6,I1)=-C
      C1(5,I1)=-2.*C
   29 CONTINUE
      IF (GIMBAL .EQ. 0) GO TO 30
      C2(5,25)=I0
      C2(6,26)=I0
      C1(5,26)=2.*I0
      C1(6,25)=-2.*I0
   30 C2(4,27)=I0
      CA2(1,3)=-MASSB
      CA2(2,1)=-2.*MASSB
      CA2(3,2)=2.*MASSB
      CA2(4,6)=I0
      CA2(5,5)=-I0
      CA2(6,4)=I0
      CA1(5,4)=2.*I0
      CA1(6,5)=2.*I0
      CALL AERO(PSIM)
      G=GAMMA*DENSER
      DO 41 K=1,NBM
      DO 42 I=1,NBM
      DC=G*MQDQ(K,I)
      DO 43 J=1,NBLADE
      K1=(K-1)*NBLADE+J
      I1=(I-1)*NBLADE+J
      IF ((K1 .GT. 15) .OR. (I1 .GT. 15)) GO TO 43
      A1(K1,I1)=A1(K1,I1)-DC
   43 CONTINUE
      DO 42 J=1,CROSS
      K1=(K-1)*NBLADE+2*J+1
      I1=(I-1)*NBLADE+2*J+1
      IF ((K1 .LE. 15) .AND. (I1 .LE. 16)) A0(K1,I1-1)=A0(K1,I1-1)+FLOAT-
     1(J)*DC
      IF ((K1 .LE. 16) .AND. (I1 .LE. 15)) A0(K1-1,I1)=A0(K1-1,I1)-FLOAT-
     1(J)*DC
   42 CONTINUE
      DO 44 I=1,NTM
      C=G*MQP(K,I)
      DO 44 J=1,NBLADE
      K1=(K-1)*NBLADE+J
      I1=(I-1)*NBLADE+J+15
      IF((K1 .LE. 15) .AND. (I1 .LE. 24)) A0(K1,I1)=A0(K1,I1)-C
   44 CONTINUE
      DC=G*MQDB(K)
      C=G*MQU(K)
      DDC=G*MQL(K)
      K1=(K-1)*NBLADE+3
      IF (GIMBAL .EQ. 0) GO TO 45
      IF (K1 .GT. 16) GO TO 45
      A1(K1-1,25)=-DC
      A0(K1-1,26)=-DC
      IF (K1 .GT. 15) GO TO 45
      A1(K1,26)=-DC
      A0(K1,25)=DC
   45 IF (K1 .GT. 17) GO TO 41
      A1(K1-2,27)=A1(K1-2,27)-G*MQDZ(K)
      A1(K1-2,28)=-DDC
      AA1(K1-2,6)=AA1(K1-2,6)-G*MQDZ(K)
      AA1(K1-2,3)=-DDC
      BG(K1-2,3)=-DDC
      IF (K1 .GT. 16) GO TO 41
      A1(K1-1,29)=-DC
      AA1(K1-1,5)=DC
      AA1(K1-1,2)=-C
      AA0(K1-1,4)=-C*LAMDA
      BG(K1-1,2)=C
      IF (K1 .GT. 15) GO TO 41
      A1(K1,30)=-DC
      AA1(K1,4)=-DC
      AA1(K1,1)=C
      AA0(K1,5)=-C*LAMDA
      BG(K1,1)=C
   41 CONTINUE
      DO 46 K=1,NTM
      DO 47 I=1,NBM
      DC=G*MPDQ(K,I)
      C=G*MPQ(K,I)
      DO 48 J=1,NBLADE
      K1=(K-1)*NBLADE+J+15
      I1=(I-1)*NBLADE+J
      IF ((K1 .GT. 24) .OR. (I1 .GT. 15)) GO TO 48
      A1(K1,I1)=-DC
      A0(K1,I1)=A0(K1,I1)-C
   48 CONTINUE
      DO 47 J=1,CROSS
      K1=(K-1)*NBLADE+2*J+16
      I1=(I-1)*NBLADE+2*J+1
      IF ((K1 .LE. 24) .AND. (I1 .LE. 16)) A0(K1,I1-1)=FLOAT(J)*DC
      IF ((K1 .LE. 25) .AND. (I1 .LE. 15)) A0(K1-1,I1)=-FLOAT(J)*DC
   47 CONTINUE
      DO 49 I=1,NTM
      DC=G*MPDP(K,I)
      C=G*MPP(K,I)
      DO 50 J=1,NBLADE
      K1=(K-1)*NBLADE+J+15
      I1=(I-1)*NBLADE+J+15
      IF ((K1 .GT. 24) .OR. (I1 .GT. 24)) GO TO 50
      A1(K1,I1)=A1(K1,I1)-DC
      A0(K1,I1)=A0(K1,I1)-C
   50 CONTINUE
      DO 49 J=1,CROSS
      K1=(K-1)*NBLADE+2*J+16
      I1=(I-1)*NBLADE+2*J+16
      IF ((K1 .LE. 24) .AND. (I1 .LE. 25)) A0(K1,I1-1)=A0(K1,I1-1)+FLOAT-
     1(J)*DC
      IF ((K1 .LE. 25) .AND. (I1 .LE. 24)) A0(K1-1,I1)=A0(K1-1,I1)-FLOAT-
     1(J)*DC
   49 CONTINUE
      C=G*MPB(K)
      DC=G*MPDB(K)
      K1=(K-1)*NBLADE+18
      IF (GIMBAL .EQ. 0) GO TO 51
      IF (K1 .GT. 25) GO TO 51
      A1(K1-1,25)=-DC
      A0(K1-1,25)=A0(K1-1,25)-C
      A0(K1-1,26)=-DC
      IF (K1 .GT. 24) GO TO 51
      A1(K1,26)=-DC
      A0(K1,26)=A0(K1,26)-C
      A0(K1,25)=DC
   51 C=G*MPU(K)
      DDC=G*MPL(K)
      IF (K1 .GT. 26) GO TO 46
      A1(K1-2,27)=-G*MPDZ(K)
      A1(K1-2,28)=-DDC
      AA1(K1-2,6)=-G*MPDZ(K)
      AA1(K1-2,3)=-DDC
      BG(K1-2,3)=-DDC
      IF (K1 .GT. 25) GO TO 46
      A1(K1-1,29)=-DC
      AA1(K1-1,5)=DC
      AA1(K1-1,2)=-C
      AA0(K1-1,4)=-C*LAMDA
      BG(K1-1,2)=C
      IF (K1 .GT. 24) GO TO 46
      A1(K1,30)=-DC
      AA1(K1,4)=-DC
      AA1(K1,1)=C
      AA0(K1,5)=-C*LAMDA
      BG(K1,1)=C
   46 CONTINUE
      IF (GIMBAL .EQ. 0) GO TO 52
      DO 53 I=1,NBM
      DC=G*MDQ(I)
      I1=(I-1)*NBLADE+3
      IF (I1 .GT. 16) GO TO 53
      A1(25,I1-1)=A1(25,I1-1)-DC
      A0(26,I1-1)=A0(26,I1-1)+DC
      IF (I1 .GT. 15) GO TO 53
      A1(26,I1)=A1(26,I1)-DC
      A0(25,I1)=A0(25,I1)-DC
   53 CONTINUE
      DO 54 I=1,NTM
      C=G*MP(I)
      I1=(I-1)*NBLADE+18
      IF (I1 .GT. 25) GO TO 54
      A0(25,I1-1)=-C
      IF (I1 .GT. 24) GO TO 54
      A0(26,I1)=-C
   54 CONTINUE
      DC=G*MDB
      A1(25,25)=A1(25,25)-DC
      A1(26,26)=A1(26,26)-DC
      A0(25,26)=-DC
      A0(26,25)=DC
      A1(26,29)=-DC
      A1(27,30)=-DC
      AA1(25,5)=DC
      AA1(26,4)=-DC
      C=G*MMU
      AA1(25,2)=-C
      AA1(26,1)=C
      AA0(25,4)=-C*LAMDA
      AA0(26,5)=-C*LAMDA
      BG(25,2)=C
      BG(26,1)=C
   52 CONTINUE
      DO 55 I=1,NBM
      I1=(I-1)*NBLADE+3
      C=G*HDQ(I)
      DDC=G*RDQ(I)
      DC=G*MDQ(I)
      IF (I1 .GT. 17) GO TO 55
      A1(27,I1-2)=A1(27,I1-2)+G*QDQ(I)
      A1(28,I1-2)=-G*TDQ(I)
      C1(1,I1-2)=G*TDQ(I)
      C1(4,I1-2)=C1(4,I1-2)+G*QDQ(I)
      IF (I1 .GT. 16) GO TO 55
      A1(29,I1-1)=-DC
      A0(30,I1-1)=DC
      C1(2,I1-1)=DDC
      C1(3,I1-1)=C
      C0(2,I1-1)=-C+G*RQ(I)
      C0(3,I1-1)=DDC
      C1(5,I1-1)=C1(5,I1-1)-DC
      C0(6,I1-1)=C0(6,I1-1)+DC
      IF (I1 .GT. 15) GO TO 55
      A1(30,I1)=-DC
      A0(29,I1)=-DC
      C1(3,I1)=-DDC
      C1(2,I1)=C
      C0(3,I1)=C-G*RQ(I)
      C0(2,I1)=DDC
      C1(6,I1)=C1(6,I1)-DC
      C0(5,I1)=C0(5,I1)-DC
   55 CONTINUE
      DO 56 I=1,NTM
      C=G*HP(I)
      DC=G*RP(I)
      I1=(I-1)*NBLADE+18
      IF (I1 .GT. 26) GO TO 56
      A0(27,I1-2)=G*QP(I)
      A0(28,I1-2)=-G*TP(I)
      C0(1,I1-2)=G*TP(I)
      C0(4,I1-2)=G*QP(I)
      IF (I1 .GT. 25) GO TO 56
      A0(29,I1-1)=-G*MP(I)
      C0(2,I1-1)=DC
      C0(3,I1-1)=C
      C0(5,I1-1)=-G*MP(I)
      IF (I1 .GT. 24) GO TO 56
      A0(30,I1)=-G*MP(I)
      C0(3,I1)=-DC
      C0(2,I1)=C
      C0(6,I1)=-G*MP(I)
   56 CONTINUE
      IF (GIMBAL .EQ. 0) GO TO 57
      C=G*HDB
      DC=G*RDB
      C1(2,25)=DC
      C1(2,26)=C
      C1(3,25)=C
      C1(3,26)=-DC
      C=C-G*RB
      C0(2,25)=-C
      C0(2,26)=DC
      C0(3,25)=DC
      C0(3,26)=C
      DC=G*MDB
      A1(29,25)=-DC
      A1(30,26)=-DC
      A0(29,26)=-DC
      A0(30,25)=DC
      C1(5,25)=-DC
      C1(6,26)=-DC
      C0(5,26)=-DC
      C0(6,25)=DC
   57 A1(27,27)=A1(27,27)+G*QDZ
      A1(28,27)=-G*TDZ
      A1(27,28)=G*QL
      A1(28,28)=A1(28,28)-G*TL
      A1(29,29)=A1(29,29)-G*MDB
      A1(30,30)=A1(30,30)-G*MDB
      C1(1,27)=G*TDZ
      C1(4,27)=G*QDZ
      C=G*(HU+RU)
      DC=G*RR
      CA1(2,1)=-C
      CA1(2,2)=DC
      CA1(3,1)=DC
      CA1(3,2)=C
      CA0(2,4)=DC*LAMDA
      CA0(2,5)=C*LAMDA
      CA0(3,4)=C*LAMDA
      CA0(3,5)=-DC*LAMDA
      DG(2,1)=C
      DG(2,2)=DC
      DG(3,1)=-DC
      DG(3,2)=C
      C=G*HDB
      DC=G*RDB
      C1(2,29)=DC
      C1(2,30)=C
      C1(3,29)=C
      C1(3,30)=-DC
      CA1(2,4)=C
      CA1(2,5)=-DC
      CA1(3,4)=-DC
      CA1(3,5)=-C
      C=G*TL
      AA1(28,3)=-C
      BG(28,3)=-C
      C1(1,28)=C
      CA1(1,3)=C
      DG(1,3)=-C
      AA1(28,6)=-G*TDZ
      CA1(1,6)=G*TDZ
      C=G*MMU
      AA1(29,2)=-C
      AA1(30,1)=C
      AA0(29,4)=-C*LAMDA
      AA0(30,5)=-C*LAMDA
      BG(29,2)=C
      BG(30,1)=C
      CA1(6,1)=C
      CA1(5,2)=-C
      CA0(5,4)=-C*LAMDA
      CA0(6,5)=-C*LAMDA
      DG(5,2)=-C
      DG(6,1)=-C
      C=G*QL
      AA1(27,3)=C
      BG(27,3)=C
      C1(4,28)=C
      CA1(4,3)=C
      DG(4,3)=-C
      C=G*MDB
      AA1(29,5)=C
      AA1(30,4)=-C
      C1(5,29)=-C
      C1(6,30)=-C
      CA1(5,5)=C
      CA1(6,4)=-C
      AA1(27,6)=G*QDZ
      CA1(4,6)=G*QDZ
      C=2.*GAMMA*DENSER/(5.7*SIGMA)*(LAMDA-MUZ)/SQRT(LAMDA**2/KHLMDA**4+-
     1(MU**2+MUY**2)/KFLMDA**2)
      DC=C*MU/KFLMDA**2
      AA1(28,1)=AA1(28,1)-DC
      BG(28,1)=BG(28,1)-DC
      DC=C*MUY/KFLMDA**2
      AA1(28,2)=AA1(28,2)+DC
      BG(28,2)=BG(28,2)-DC
      DC=C*LAMDA/KHLMDA**4
      AA1(28,3)=AA1(28,3)+DC
      BG(28,3)=BG(28,3)+DC
      IF (ROTATE .EQ. -1) CALL REQROT
      RETURN
      END
      SUBROUTINE ROTOR(OPTION,PSI,NBLD)
      INTEGER OPTION
      COMMON /RINPUT/TYPE,NBLADE,DEL3G,NTRIM0,NTRIM1,MU,LAMDA,MTIP,NBM,N-
     1TM,GIMBAL,GAMMA,OMEGA,RADIUS,SIGMA,OPAERO,MRAERO,BBLD,RROOT,INCOMP-
     2,T1C,T1S,T75,MPSI,MREV,OPMODE,OFFSET,MRMODE,NONROT,NCOLB,CONE,IB,D-
     3EL1,XFA,KPG,GGS,GQS(5),GPS(3),NCOLT,WT0,RFA,HSPRC,HSPRS,KPB(5),RPH-
     4,XPH,WTCH,WTSH,WTRH,WTC,WTS,WTR,NUGC,NUGS,KFLAP,KLAG,HINGE,KPIN,AT-
     5ANKP(5),DROOP,SWEEP,DEL2,DEL3,ZFA,VTIPN,DEBUGR,EPMODE,GLAG,LDAMP,E-
     6XDAMP,PHIPH,PHIPL,LDAMPC,MUY,MUZ,CHORD(51),XA(51),MASS(51),XI(51),-
     7THETA(51),ITHETA(51),TWIST(51),EIZZ(51),EIXX(51),GJ(51),XC(51),DEN-
     8SER,OPUNIR,ELAG,VTOT,KHLMDA,KFLMDA,ALFHP,PSIHP,T75IN,T1CIN,T1SIN,I-
     9RING,ROTATE,FDROOP,FSWEEP,DEL4,DEL5
      REAL MU,LAMDA,MTIP,IB,MASS,ITHETA,KPG,NUGC,NUGS,KPB,KFLAP,KLAG,LDA-
     1MP,LDAMPC,MUY,MUZ,KHLMDA,KFLMDA
      INTEGER OPAERO,GIMBAL,OPMODE,HINGE,DEBUGR,OPUNIR,ROTATE
      COMMON /MODES/ETA(5,2,51),ETAP(5,2,51),ETAPP(5,2,51),NU(5),ZETA(3,-
     151),ZETAP(3,51),WT(3),EFA(5,2),EFAP(5,2),EFAPP(5,2)
      REAL NU
      COMMON /BAERO/MQU(5),MQDZ(5),MQZ(5),MQL(5),MQDB(5),MQB(5),MQDQ(5,5-
     1),MQQ(5,5),MQP(5,3),MMU,MDZ,MZ,ML,MDB,MB,MDQ(5),MQ(5),MP(3),TU,TDZ-
     2,TZ,TL,TDB,TB,TDQ(5),TQ(5),TP(3),HU,HDZ,HZ,HL,HDB,HB,HDQ(5),HQ(5),-
     3HP(3),QU,QDZ,QZ,QL,QDB,QB,QDQ(5),QQ(5),QP(3),RR,RU,RDZ,RZ,RL,RDB,R-
     4B,RDQ(5),RQ(5),RP(3),MPU(3),MPDZ(3),MPZ(3),MPL(3),MPDB(3),MPB(3),M-
     5PDQ(3,5),MPQ(3,5),MPP(3,3),MPDP(3,3),FZ0,FX0
      REAL MQU,MQDZ,MQZ,MQL,MQDB,MQB,MQDQ,MQQ,MQP,MMU,MDZ,MZ,ML,MDB,MB,M-
     1DQ,MQ,MP,MPU,MPDZ,MPZ,MPL,MPDB,MPB,MPDQ,MPQ,MPP,MPDP
      COMMON /BINERT/   I0,SQ(5,2),IQA(5,2),SPA(3,2),IDQA(5),IDQP(5),IQ(-
     15),SQDDP(5,3),SQP(5,3),IQDQ(5,5),IP(3),SP(3,2),IPA(3,2),SPDDA(3),S-
     2PDDQ(3,5),SPQ(3,5),IPDDP(3,3),IPP(3,3),XATOR(3,2,51),DXATOR(3,5,2,-
     351),MASSB,IQDP(5),IDQA0
      REAL MASSB,I0,IQA,IDQA,IDQP,IQ,IQDQ,IP,IPA,IPDDP,IPP,IQDP,IDQA0
      COMMON /RCOEF/A2(30,30),A1(30,30),A0(30,30),AA2(30,6),AA1(30,6),AA-
     10(30,6),B(30,8),BG(30,3),C2(6,30),C1(6,30),C0(6,30),CA2(6,6),CA1(6-
     2,6),CA0(6,6),DG(6,3)
      DIMENSION ZERO(4236)
      EQUIVALENCE (ZERO(1),A2(1,1))
      DIMENSION F(8,8),DF(8,8),DDF(8,8),FCOL(8),DFCOL(8),DDFCOL(8),FROW(-
     18)
      INTEGER EVEN,CROSS
      EVEN=0
      IF (NBLADE/2*2 .EQ. NBLADE) EVEN=1
      CROSS=(NBLADE-1)/2
      DO 1 I=1,4236
    1 ZERO(I)=0.
      H=1./FLOAT(NBLD)
      DPSI=6.283185/FLOAT(NBLD)
      G=GAMMA*DENSER/FLOAT(NBLD)
      IRE=IFIX(ELAG*50.)+2
      DO 4 JPSI=1,NBLD
      PSIM=FLOAT(JPSI)*DPSI+PSI
      FROW(1)=1.
      FCOL(1)=1.
      DFCOL(1)=0.
      DDFCOL(1)=0.
      DO 251 J=1,CROSS
      SN=SIN(FLOAT(J)*PSIM)
      CS=COS(FLOAT(J)*PSIM)
      FROW(2*J)=2.*CS
      FCOL(2*J)=CS
      DFCOL(2*J)=-SN*FLOAT(J)
      DDFCOL(2*J)=-CS*FLOAT(J)**2
      FROW(2*J+1)=2.*SN
      FCOL(2*J+1)=SN
      DFCOL(2*J+1)=CS*FLOAT(J)
  251 DDFCOL(2*J+1)=-SN*FLOAT(J)**2
      IF (EVEN .NE. 1) GO TO 252
      FROW(NBLADE)=0.
      FCOL(NBLADE)=0.
      DFCOL(NBLADE)=0.
      DDFCOL(NBLADE)=0.
      IF (OPTION .LT. 0) GO TO 252
      FROW(NBLADE)=1.
      FCOL(NBLADE)=1.
      IF (JPSI/2*2 .EQ. JPSI) GO TO 252
      FROW(NBLADE)=-1.
      FCOL(NBLADE)=-1.
  252 CONTINUE
      DO 253 I=1,NBLADE
      DO 253 K=1,NBLADE
      F(K,I)=H*FROW(K)*FCOL(I)
      DF(K,I)=H*FROW(K)*DFCOL(I)
  253 DDF(K,I)=H*FROW(K)*DDFCOL(I)
      IF (EVEN .EQ. 1) F(NBLADE,NBLADE)=H
      SN=SIN(PSIM)
      CS=COS(PSIM)
      CALL INERT(PSIM)
      DO 11 K=1,NBM
      DO 11 JK=1,NBLADE
      K1=(K-1)*NBLADE+JK
      IF (K1 .GT. 15) GO TO 11
      F1=F(JK,1)
      F2=F(JK,2)
      F3=F(JK,3)
      DO 12 I=1,NBM
      C=0.
      IF (K .EQ. I) C=IQ(K)
      DC=C*GQS(K)*NU(K)+2.*IQDQ(K,I)+GLAG*ETAP(K,2,IRE)*ETAP(I,2,IRE)
      DDC=C*NU(K)**2
      DO 12 JI=1,NBLADE
      I1=(I-1)*NBLADE+JI
      IF (I1 .GT. 15) GO TO 12
      A2(K1,I1)=A2(K1,I1)+C*F(JK,JI)
      A1(K1,I1)=A1(K1,I1)+DC*F(JK,JI)+2.*C*DF(JK,JI)
      A0(K1,I1)=A0(K1,I1)+DDC*F(JK,JI)+C*DDF(JK,JI)+DC*DF(JK,JI)
   12 CONTINUE
      DO 13 I=1,NTM
      C=SQP(K,I)
      DDC=SQDDP(K,I)
      DO 13 JI=1,NBLADE
      I1=(I-1)*NBLADE+JI+15
      IF (I1 .GT. 24) GO TO 13
      A2(K1,I1)=A2(K1,I1)-DDC*F(JK,JI)
      A1(K1,I1)=A1(K1,I1)-2.*DDC*DF(JK,JI)
      A0(K1,I1)=A0(K1,I1)-C*F(JK,JI)-DDC*DDF(JK,JI)
   13 CONTINUE
      C=IQA(K,1)
      DC=IDQA(K)
      DO 14 JI=2,3
      A2(K1,JI+23)=A2(K1,JI+23)+C*F(JK,JI)-DC*DF(JK,JI)
   14 A1(K1,JI+23)=A1(K1,JI+23)+2.*C*DF(JK,JI)
      A2(K1,27)=A2(K1,27)+IQA(K,2)*F1
      A1(K1,27)=A1(K1,27)+2.*IQDP(K)*F1
      AA2(K1,1)=AA2(K1,1)-SQ(K,2)*F3
      AA2(K1,2)=AA2(K1,2)+SQ(K,2)*F2
      AA2(K1,3)=AA2(K1,3)+SQ(K,1)*F1
      AA2(K1,4)=AA2(K1,4)+C*F3
      AA2(K1,5)=AA2(K1,5)-C*F2
      AA2(K1,6)=AA2(K1,6)+IQA(K,2)*F1
      AA1(K1,4)=AA1(K1,4)+2.*C*DF(JK,3)
      AA1(K1,5)=AA1(K1,5)-2.*C*DF(JK,2)
      AA1(K1,6)=AA1(K1,6)+2.*IQDP(K)*F1
   11 CONTINUE
      DO 21 K=1,NTM
      DO 21 JK=1,NBLADE
      K1=(K-1)*NBLADE+JK+15
      IF (K1 .GT. 24) GO TO 21
      F1=F(JK,1)
      F2=F(JK,2)
      F3=F(JK,3)
      WTORS=WT(K)
      IF ((K.EQ.1).AND.(JK.EQ.2)) WTORS=WTC
      IF ((K.EQ.1).AND.(JK.EQ.3)) WTORS=WTS
      IF ((K.EQ.1).AND.(JK.GE.4)) WTORS=WTR
      DO 22 I=1,NBM
      C=SPQ(K,I)
      DDC=SPDDQ(K,I)
      IF (K .EQ. 1) C=C-KPB(I)*IP(1)*WTORS**2
      DO 22 JI=1,NBLADE
      I1=(I-1)*NBLADE+JI
      IF (I1 .GT. 15) GO TO 22
      A2(K1,I1)=A2(K1,I1)-DDC*F(JK,JI)
      A1(K1,I1)=A1(K1,I1)-2.*DDC*DF(JK,JI)
      A0(K1,I1)=A0(K1,I1)-DDC*DDF(JK,JI)-C*F(JK,JI)
   22 CONTINUE
      DO 23 I=1,NTM
      C=0.
      IF (K .EQ. I) C=IP(K)
      DC=C*GPS(K)*WT(K)
      DDC=C*WTORS**2+IPP(K,I)
      C=C+IPDDP(K,I)
      DO 23 JI=1,NBLADE
      I1=(I-1)*NBLADE+JI+15
      IF (I1 .GT. 24) GO TO 23
      A2(K1,I1)=A2(K1,I1)+C*F(JK,JI)
      A1(K1,I1)=A1(K1,I1)+DC*F(JK,JI)+2.*C*DF(JK,JI)
      A0(K1,I1)=A0(K1,I1)+DDC*F(JK,JI)+DC*DF(JK,JI)+C*DDF(JK,JI)
   23 CONTINUE
      IF ((K.EQ.1).AND.(JK.LE.8)) B(K1,JK)=B(K1,JK)+IP(1)*WTORS**2*H
      C=IPA(K,2)
      DC=SPDDA(K)
      DO 24 JI=2,3
      A2(K1,JI+23)=A2(K1,JI+23)-C*F(JK,JI)-DC*DF(JK,JI)
   24 A1(K1,JI+23)=A1(K1,JI+23)-2.*C*DF(JK,JI)
      IF (K1 .EQ. 17) A0(17,25)=A0(17,25)+KPG*IP(1)*WTC**2*H
      IF (K1 .EQ. 18) A0(18,26)=A0(18,26)+KPG*IP(1)*WTS**2*H
      IF (K1 .EQ. 17) A0(17,27)=A0(17,27)-IP(1)*WTC**2*T1S*H
      IF (K1 .EQ. 18) A0(18,27)=A0(18,27)+IP(1)*WTS**2*T1C*H
      A2(K1,27)=A2(K1,27)+IPA(K,1)*F1
      AA2(K1,1)=AA2(K1,1)-SP(K,1)*F3
      AA2(K1,2)=AA2(K1,2)+SP(K,1)*F2
      AA2(K1,3)=AA2(K1,3)-SP(K,2)*F1
      AA2(K1,4)=AA2(K1,4)-C*F3
      AA2(K1,5)=AA2(K1,5)+C*F2
      AA2(K1,6)=AA2(K1,6)+IPA(K,1)*F1
      AA1(K1,4)=AA1(K1,4)-2.*C*DF(JK,3)
      AA1(K1,5)=AA1(K1,5)+2.*C*DF(JK,2)
   21 CONTINUE
      IF (GIMBAL .EQ. 0) GO TO 30
      DO 31 JK=2,3
      K1=JK+23
      DO 32 I=1,NBM
      C=IQA(I,1)
      DC=IDQA(I)
      DO 32 JI=1,NBLADE
      I1=(I-1)*NBLADE+JI
      IF (I1 .GT. 15) GO TO 32
      A2(K1,I1)=A2(K1,I1)+C*F(JK,JI)
      A1(K1,I1)=A1(K1,I1)+2.*DC*F(JK,JI)+2.*C*DF(JK,JI)
      A0(K1,I1)=A0(K1,I1)+2.*DC*DF(JK,JI)
   32 CONTINUE
      DO 33 I=1,NTM
      C=SPA(I,1)
      DO 33 JI=1,NBLADE
      I1=(I-1)*NBLADE+JI+15
      IF (I1 .GT. 24) GO TO 33
      A2(K1,I1)=A2(K1,I1)-C*F(JK,JI)
      A1(K1,I1)=A1(K1,I1)-2.*C*DF(JK,JI)
      A0(K1,I1)=A0(K1,I1)-C*(F(JK,JI)+DDF(JK,JI))
   33 CONTINUE
   31 A1(K1,27)=A1(K1,27)+2.*IDQA0*F(JK,1)
      C=I0*H
      A2(25,25)=A2(25,25)+C
      A2(26,26)=A2(26,26)+C
      A1(25,25)=A1(25,25)+C*GGS*SQRT(NUGC**2-.999)
      A1(25,26)=A1(25,26)+2.*C
      A1(26,25)=A1(26,25)-2.*C
      A1(26,26)=A1(26,26)+C*GGS*SQRT(NUGS**2-.999)
      A0(25,25)=A0(25,25)+C*(NUGC**2-1.)
      A0(26,26)=A0(26,26)+C*(NUGS**2-1.)
      AA2(25,5)=AA2(25,5)-C
      AA2(26,4)=AA2(26,4)+C
      AA1(25,4)=AA1(25,4)+2.*C
      AA1(26,5)=AA1(26,5)+2.*C
   30 CONTINUE
      DO 41 I=1,NBM
      DO 41 JI=1,NBLADE
      I1=(I-1)*NBLADE+JI
      IF (I1 .GT. 15) GO TO 41
      C=SQ(I,2)
      DC=IQA(I,1)
      DDC=IDQA(I)
      F1=F(1,JI)
      F2=F(2,JI)
      F3=F(3,JI)
      A2(27,I1)=A2(27,I1)+IQA(I,2)*F1
      A1(27,I1)=A1(27,I1)-2.*IDQP(I)*F1
      A0(27,I1)=A0(27,I1)-2.*IDQP(I)*DF(1,JI)
      C2(1,I1)=C2(1,I1)-SQ(I,1)*F1
      C2(2,I1)=C2(2,I1)+C*F3
      C2(3,I1)=C2(3,I1)+C*F2
      C2(4,I1)=C2(4,I1)+IQA(I,2)*F1
      C2(5,I1)=C2(5,I1)+DC*F2
      C2(6,I1)=C2(6,I1)+DC*F3
      C1(4,I1)=C1(4,I1)-2.*IDQP(I)*F1
      C1(5,I1)=C1(5,I1)+2.*DDC*F2+2.*DC*DF(2,JI)
      C1(6,I1)=C1(6,I1)+2.*DDC*F3+2.*DC*DF(3,JI)
      C0(4,I1)=C0(4,I1)-2.*IDQP(I)*DF(1,JI)
      C0(5,I1)=C0(5,I1)+2.*DDC*DF(2,JI)
      C0(6,I1)=C0(6,I1)+2.*DDC*DF(3,JI)
   41 CONTINUE
      DO 42 I=1,NTM
      DO 42 JI=1,NBLADE
      I1=(I-1)*NBLADE+JI+15
      IF (I1 .GT. 24) GO TO 42
      F1=F(1,JI)
      F2=F(2,JI)
      F3=F(3,JI)
      C=SPA(I,1)
      DC=SPA(I,2)
      A2(27,I1)=A2(27,I1)-DC*F1
      A1(27,I1)=A1(27,I1)-2.*DC*DF(1,JI)
      A0(27,I1)=A0(27,I1)-DC*DDF(1,JI)
      C2(4,I1)=C2(4,I1)-DC*F1
      C2(5,I1)=C2(5,I1)-C*F2
      C2(6,I1)=C2(6,I1)-C*F3
      C1(4,I1)=C1(4,I1)-2.*DC*DF(1,JI)
      C1(5,I1)=C1(5,I1)-2.*C*DF(2,JI)
      C1(6,I1)=C1(6,I1)-2.*C*DF(3,JI)
      C0(4,I1)=C0(4,I1)-DC*DDF(1,JI)
      C0(5,I1)=C0(5,I1)-C*(DDF(2,JI)+F2)
      C0(6,I1)=C0(6,I1)-C*(DDF(3,JI)+F3)
   42 CONTINUE
      DDC=MASSB*H
      DC=IDQA0*H
      C=I0*H
      A1(27,25)=A1(27,25)-2.*DC*CS
      A1(27,26)=A1(27,26)-2.*DC*SN
      A0(27,25)=A0(27,25)+2.*DC*SN
      A0(27,26)=A0(27,26)-2.*DC*CS
      A2(27,27)=A2(27,27)+C
      AA2(27,6)=AA2(27,6)+C
      C2(4,27)=C2(4,27)+C
      C2(5,25)=C2(5,25)+C
      C2(6,26)=C2(6,26)+C
      C1(5,26)=C1(5,26)+2.*C
      C1(6,25)=C1(6,25)-2.*C
      C1(4,25)=C1(4,25)-2.*DC*CS
      C1(4,26)=C1(4,26)-2.*DC*SN
      C1(5,27)=C1(5,27)+4.*DC*CS
      C1(6,27)=C1(6,27)+4.*DC*SN
      C0(4,25)=C0(4,25)+2.*DC*SN
      C0(4,26)=C0(4,26)-2.*DC*CS
      CA2(1,3)=CA2(1,3)-DDC
      CA2(2,1)=CA2(2,1)-2.*DDC
      CA2(3,2)=CA2(3,2)+2.*DDC
      CA2(4,6)=CA2(4,6)+C
      CA2(5,5)=CA2(5,5)-C
      CA2(6,4)=CA2(6,4)+C
      CA1(5,4)=CA1(5,4)+2.*C
      CA1(6,5)=CA1(6,5)+2.*C
      CALL AERO(PSIM)
      GS=G*SN
      GC=G*CS
      G2S=GS*2.
      G2C=GC*2.
      GS2=G*SN*SN*2.
      GC2=G*CS*CS*2.
      GCS=G*SN*CS*2.
      DO 254 I=1,NBLADE
      DO 254 K=1,NBLADE
      F(K,I)=F(K,I)*GAMMA*DENSER
  254 DF(K,I)=DF(K,I)*GAMMA*DENSER
      DO 69 K=1,NBM
      DO 69 JK=1,NBLADE
      K1=(K-1)*NBLADE+JK
      IF (K1 .GT. 15) GO TO 69
      F1=F(JK,1)
      F3=F(JK,3)
      DO 62 I=1,NBM
      C=MQQ(K,I)
      DC=MQDQ(K,I)
      DO 62 JI=1,NBLADE
      I1=(I-1)*NBLADE+JI
      IF (I1 .GT. 15) GO TO 62
      A1(K1,I1)=A1(K1,I1)-DC*F(JK,JI)
      A0(K1,I1)=A0(K1,I1)-C*F(JK,JI)-DC*DF(JK,JI)
   62 CONTINUE
      DO 63 I=1,NTM
      C=MQP(K,I)
      DO 63 JI=1,NBLADE
      I1=(I-1)*NBLADE+JI+15
      IF (I1 .GT. 24) GO TO 63
      A0(K1,I1)=A0(K1,I1)-C*F(JK,JI)
   63 CONTINUE
      DC=MQDB(K)
      C=MQB(K)
      DO 65 JI=2,3
      A1(K1,JI+23)=A1(K1,JI+23)-DC*F(JK,JI)
      A0(K1,JI+23)=A0(K1,JI+23)-C*F(JK,JI)-DC*DF(JK,JI)
      A1(K1,JI+27)=A1(K1,JI+27)-DC*F(JK,JI)
   65 AA1(K1,JI+2)=AA1(K1,JI+2)+DC*DF(JK,JI)
      DC=MQDZ(K)
      C=MQZ(K)
      A1(K1,27)=A1(K1,27)-DC*F1
      A0(K1,27)=A0(K1,27)-C*F1
      AA1(K1,6)=AA1(K1,6)-DC*F1
      AA0(K1,6)=AA0(K1,6)-C*F1
      C=MQU(K)
      DC=MQL(K)
      A1(K1,28)=A1(K1,28)-DC*F1
      DO 68 JI=2,3
      AA1(K1,JI-1)=AA1(K1,JI-1)-C*DF(JK,JI)
   68 AA0(K1,JI+2)=AA0(K1,JI+2)-C*LAMDA*F(JK,JI)
      AA1(K1,3)=AA1(K1,3)-DC*F1
      AA0(K1,4)=AA0(K1,4)+DC*MUY*F1
      AA0(K1,5)=AA0(K1,5)+DC*MU*F1
      BG(K1,1)=BG(K1,1)+C*F3
      BG(K1,2)=BG(K1,2)+C*F(JK,2)
      BG(K1,3)=BG(K1,3)-DC*F1
   69 CONTINUE
      DO 79 K=1,NTM
      DO 79 JK=1,NBLADE
      K1=(K-1)*NBLADE+JK+15
      IF (K1 .GT. 24) GO TO 79
      F1=F(JK,1)
      F3=F(JK,3)
      DO 72 I=1,NBM
      C=MPQ(K,I)
      DC=MPDQ(K,I)
      DO 72 JI=1,NBLADE
      I1=(I-1)*NBLADE+JI
      IF (I1 .GT. 15) GO TO 72
      A1(K1,I1)=A1(K1,I1)-DC*F(JK,JI)
      A0(K1,I1)=A0(K1,I1)-C*F(JK,JI)-DC*DF(JK,JI)
   72 CONTINUE
      DO 73 I=1,NTM
      DC=MPDP(K,I)
      C=MPP(K,I)
      DO 73 JI=1,NBLADE
      I1=(I-1)*NBLADE+JI+15
      IF (I1 .GT. 24) GO TO 73
      A1(K1,I1)=A1(K1,I1)-DC*F(JK,JI)
      A0(K1,I1)=A0(K1,I1)-C*F(JK,JI)-DC*DF(JK,JI)
   73 CONTINUE
      DC=MPDB(K)
      C=MPB(K)
      DO 75 JI=2,3
      A1(K1,JI+23)=A1(K1,JI+23)-DC*F(JK,JI)
      A0(K1,JI+23)=A0(K1,JI+23)-C*F(JK,JI)-DC*DF(JK,JI)
      A1(K1,JI+27)=A1(K1,JI+27)-DC*F(JK,JI)
   75 AA1(K1,JI+2)=AA1(K1,JI+2)+DC*DF(JK,JI)
      DC=MPDZ(K)
      C=MPZ(K)
      A1(K1,27)=A1(K1,27)-DC*F1
      A0(K1,27)=A0(K1,27)-C*F1
      AA1(K1,6)=AA1(K1,6)-DC*F1
      AA0(K1,6)=AA0(K1,6)-C*F1
      C=MPU(K)
      DC=MPL(K)
      A1(K1,28)=A1(K1,28)-DC*F1
      DO 78 JI=2,3
      AA1(K1,JI-1)=AA1(K1,JI-1)-C*DF(JK,JI)
   78 AA0(K1,JI+2)=AA0(K1,JI+2)-C*LAMDA*F(JK,JI)
      AA1(K1,3)=AA1(K1,3)-DC*F1
      AA0(K1,4)=AA0(K1,4)+DC*MUY*F1
      AA0(K1,5)=AA0(K1,5)+DC*MU*F1
      BG(K1,1)=BG(K1,1)+C*F3
      BG(K1,2)=BG(K1,2)+C*F(JK,2)
      BG(K1,3)=BG(K1,3)-DC*F1
   79 CONTINUE
      IF (GIMBAL .EQ. 0) GO TO 81
      DO 89 JK=2,3
      F1=F(JK,1)
      F3=F(JK,3)
      K1=JK+23
      DO 82 I=1,NBM
      C=MQ(I)
      DC=MDQ(I)
      DO 82 JI=1,NBLADE
      I1=(I-1)*NBLADE+JI
      IF (I1 .GT. 15) GO TO 82
      A1(K1,I1)=A1(K1,I1)-DC*F(JK,JI)
      A0(K1,I1)=A0(K1,I1)-C*F(JK,JI)-DC*DF(JK,JI)
   82 CONTINUE
      DO 83 I=1,NTM
      C=MP(I)
      DO 83 JI=1,NBLADE
      I1=(I-1)*NBLADE+JI+15
      IF (I1 .GT. 24) GO TO 83
      A0(K1,I1)=A0(K1,I1)-C*F(JK,JI)
   83 CONTINUE
      DO 85 JI=2,3
      A1(K1,JI+23)=A1(K1,JI+23)-MDB*F(JK,JI)
      A0(K1,JI+23)=A0(K1,JI+23)-MB*F(JK,JI)-MDB*DF(JK,JI)
      A1(K1,JI+27)=A1(K1,JI+27)-MDB*F(JK,JI)
   85 AA1(K1,JI+2)=AA1(K1,JI+2)+MDB*DF(JK,JI)
      A1(K1,27)=A1(K1,27)-MDZ*F1
      A0(K1,27)=A0(K1,27)-MZ*F1
      AA1(K1,6)=AA1(K1,6)-MDZ*F1
      AA0(K1,6)=AA0(K1,6)-MZ*F1
      A1(K1,28)=A1(K1,28)-ML*F1
      DO 88 JI=2,3
      AA1(K1,JI-1)=AA1(K1,JI-1)-MMU*DF(JK,JI)
   88 AA0(K1,JI+2)=AA0(K1,JI+2)-MMU*LAMDA*F(JK,JI)
      AA1(K1,3)=AA1(K1,3)-ML*F1
      AA0(K1,4)=AA0(K1,4)+ML*MUY*F1
      AA0(K1,5)=AA0(K1,5)+ML *MU*F1
      BG(K1,1)=BG(K1,1)+MMU*F3
      BG(K1,2)=BG(K1,2)+MMU*F(JK,2)
   89 BG(K1,3)=BG(K1,3)-ML*F1
   81 CONTINUE
      DO 60 I=1,NBM
      C=HDQ(I)
      DC=RDQ(I)
      DO 60 JI=1,NBLADE
      I1=(I-1)*NBLADE+JI
      IF (I1 .GT. 15) GO TO 60
      F1=F(1,JI)
      F2=F(2,JI)
      F3=F(3,JI)
      A1(27,I1)=A1(27,I1)+QDQ(I)*F1
      A1(28,I1)=A1(28,I1)-TDQ(I)*F1
      A1(29,I1)=A1(29,I1)-MDQ(I)*F2
      A1(30,I1)=A1(30,I1)-MDQ(I)*F3
      A0(27,I1)=A0(27,I1)+QDQ(I)*DF(1,JI)+QQ(I)*F1
      A0(28,I1)=A0(28,I1)-TDQ(I)*DF(1,JI)-TQ(I)*F1
      A0(29,I1)=A0(29,I1)-MDQ(I)*DF(2,JI)-MQ(I)*F2
      A0(30,I1)=A0(30,I1)-MDQ(I)*DF(3,JI)-MQ(I)*F3
      C1(1,I1)=C1(1,I1)+TDQ(I)*F1
      C1(2,I1)=C1(2,I1)+C*F3     +DC*F2
      C1(3,I1)=C1(3,I1)+C*F2     -DC*F3
      C1(4,I1)=C1(4,I1)+QDQ(I)*F1
      C1(5,I1)=C1(5,I1)-MDQ(I)*F2
      C1(6,I1)=C1(6,I1)-MDQ(I)*F3
      C0(1,I1)=C0(1,I1)+TDQ(I)*DF(1,JI)+TQ(I)*F1
      C0(2,I1)=C0(2,I1)+C*DF(3,JI)+HQ(I)*F3     +DC*DF(2,JI)+RQ(I)*F2
      C0(3,I1)=C0(3,I1)+C*DF(2,JI)+HQ(I)*F2     -DC*DF(3,JI)-RQ(I)*F3
      C0(4,I1)=C0(4,I1)+QDQ(I)*DF(1,JI)+QQ(I)*F1
      C0(5,I1)=C0(5,I1)-MDQ(I)*DF(2,JI)-MQ(I)*F2
      C0(6,I1)=C0(6,I1)-MDQ(I)*DF(3,JI)-MQ(I)*F3
   60 CONTINUE
      DO 70 I=1,NTM
      DO 70 JI=1,NBLADE
      I1=(I-1)*NBLADE+JI+15
      IF (I1 .GT. 24) GO TO 70
      F1=F(1,JI)
      F2=F(2,JI)
      F3=F(3,JI)
      A0(27,I1)=A0(27,I1)+QP(I)*F1
      A0(28,I1)=A0(28,I1)-TP(I)*F1
      A0(29,I1)=A0(29,I1)-MP(I)*F2
      A0(30,I1)=A0(30,I1)-MP(I)*F3
      C0(1,I1)=C0(1,I1)+TP(I)*F1
      C0(2,I1)=C0(2,I1)+HP(I)*F3     +RP(I)*F2
      C0(3,I1)=C0(3,I1)+HP(I)*F2     -RP(I)*F3
      C0(4,I1)=C0(4,I1)+QP(I)*F1
      C0(5,I1)=C0(5,I1)-MP(I)*F2
      C0(6,I1)=C0(6,I1)-MP(I)*F3
   70 CONTINUE
      IF (GIMBAL .EQ. 0) GO TO 80
      DO 91 JI=2,3
      F1=F(1,JI)
      F2=F(2,JI)
      F3=F(3,JI)
      A1(27,I1)=A1(27,I1)+QDB*F1
      A1(28,I1)=A1(28,I1)-TDB*F1
      A1(29,I1)=A1(29,I1)-MDB*F2
      A1(30,I1)=A1(30,I1)-MDB*F3
      A0(27,I1)=A0(27,I1)+QDB*DF(1,JI)+QB*F1
      A0(28,I1)=A0(28,I1)-TDB*DF(1,JI)-TB*F1
      A0(29,I1)=A0(29,I1)-MDB*DF(2,JI)-MB*F2
      A0(30,I1)=A0(30,I1)-MDB*DF(3,JI)-MB*F3
      I1=JI+23
      C1(1,I1)=C1(1,I1)+TDB*F1
      C1(2,I1)=C1(2,I1)+HDB*F3+RDB*F2
      C1(3,I1)=C1(3,I1)+HDB*F2-RDB*F3
      C1(4,I1)=C1(4,I1)+QDB*F1
      C1(5,I1)=C1(5,I1)-MDB*F2
      C1(6,I1)=C1(6,I1)-MDB*F3
      C0(1,I1)=C0(1,I1)+TDB*DF(1,JI)+TB*F1
      C0(2,I1)=C0(2,I1)+HDB*DF(3,JI)+HB*F3+RDB*DF(2,JI)+RB*F2
      C0(3,I1)=C0(3,I1)+HDB*DF(2,JI)+HB*F2-RDB*DF(3,JI)-RB*F3
      C0(4,I1)=C0(4,I1)+QDB*DF(1,JI)+QB*F1
      C0(5,I1)=C0(5,I1)-MDB*DF(2,JI)-MB*F2
   91 C0(6,I1)=C0(6,I1)-MDB*DF(3,JI)-MB*F3
   80 A1(27,27)=A1(27,27)+QDZ*G
      A1(28,27)=A1(28,27)-TDZ*G
      A1(29,27)=A1(29,27)-MDZ*G2C
      A1(30,27)=A1(30,27)-MDZ*G2S
      A1(27,28)=A1(27,28)+QL*G
      A1(28,28)=A1(28,28)-TL*G
      A1(29,28)=A1(29,28)-ML*G2C
      A1(30,28)=A1(30,28)-ML*G2S
      A1(27,29)=A1(27,29)+QDB*GC
      A1(28,29)=A1(28,29)-TDB*GC
      A1(29,29)=A1(29,29)-MDB*GC2
      A1(30,29)=A1(30,29)-MDB*GCS
      A1(27,30)=A1(27,30)+QDB*GS
      A1(28,30)=A1(28,30)-TDB*GS
      A1(29,30)=A1(29,30)-MDB*GCS
      A1(30,30)=A1(30,30)-MDB*GS2
      A0(27,27)=A0(27,27)+QZ*G
      A0(28,27)=A0(28,27)-TZ*G
      A0(29,27)=A0(29,27)-MZ*G2C
      A0(30,27)=A0(30,27)-MZ*G2S
      AA1(27,1)=AA1(27,1)-QU*GS
      AA1(28,1)=AA1(28,1)+TU*GS
      AA1(29,1)=AA1(29,1)+MMU*GCS
      AA1(30,1)=AA1(30,1)+MMU*GS2
      AA1(27,2)=AA1(27,2)+QU*GC
      AA1(28,2)=AA1(28,2)-TU*GC
      AA1(29,2)=AA1(29,2)-MMU*GC2
      AA1(30,2)=AA1(30,2)-MMU*GCS
      AA1(27,3)=AA1(27,3)+QL*G
      AA1(28,3)=AA1(28,3)-TL*G
      AA1(29,3)=AA1(29,3)-ML*G2C
      AA1(30,3)=AA1(30,3)-ML*G2S
      AA1(27,4)=AA1(27,4)+QDB*GS
      AA1(28,4)=AA1(28,4)-TDB*GS
      AA1(29,4)=AA1(29,4)-MDB*GCS
      AA1(30,4)=AA1(30,4)-MDB*GS2
      AA1(27,5)=AA1(27,5)-QDB*GC
      AA1(28,5)=AA1(28,5)+TDB*GC
      AA1(29,5)=AA1(29,5)+MDB*GC2
      AA1(30,5)=AA1(30,5)+MDB*GCS
      AA1(27,6)=AA1(27,6)+QDZ*G
      AA1(28,6)=AA1(28,6)-TDZ*G
      AA1(29,6)=AA1(29,6)-MDZ*G2C
      AA1(30,6)=AA1(30,6)-MDZ*G2S
      AA0(27,4)=AA0(27,4)+QU*LAMDA*GC-QL*MUY*G
      AA0(28,4)=AA0(28,4)-TU*LAMDA*GC+TL*MUY*G
      AA0(29,4)=AA0(29,4)-MMU*LAMDA*GC2+ML*MUY*G2C
      AA0(30,4)=AA0(30,4)-MMU*LAMDA*GCS+ML*MUY*G2S
      AA0(27,5)=AA0(27,5)+QU*LAMDA*GS-QL*MU*G
      AA0(28,5)=AA0(28,5)-TU*LAMDA*GS+TL*MU*G
      AA0(29,5)=AA0(29,5)-MMU*LAMDA*GCS+ML*MU*G2C
      AA0(30,5)=AA0(30,5)-MMU*LAMDA*GS2+ML*MU*G2S
      AA0(27,6)=AA0(27,6)+QZ*G
      AA0(28,6)=AA0(28,6)-TZ*G
      AA0(29,6)=AA0(29,6)-MZ*G2C
      AA0(30,6)=AA0(30,6)-MZ*G2S
      BG(27,1)=BG(27,1)-QU*GS
      BG(28,1)=BG(28,1)+TU*GS
      BG(29,1)=BG(29,1)+MMU*GCS
      BG(30,1)=BG(30,1)+MMU*GS2
      BG(27,2)=BG(27,2)-QU*GC
      BG(28,2)=BG(28,2)+TU*GC
      BG(29,2)=BG(29,2)+MMU*GC2
      BG(30,2)=BG(30,2)+MMU*GCS
      BG(27,3)=BG(27,3)+QL*G
      BG(28,3)=BG(28,3)-TL*G
      BG(29,3)=BG(29,3)-ML*G2C
      BG(30,3)=BG(30,3)-ML*G2S
      C1(1,28)=C1(1,28)+TL*G
      C1(2,28)=C1(2,28)+HL*G2S+RL*G2C
      C1(3,28)=C1(3,28)+HL*G2C-RL*G2S
      C1(4,28)=C1(4,28)+QL*G
      C1(5,28)=C1(5,28)-ML*G2C
      C1(6,28)=C1(6,28)-ML*G2S
      C1(1,29)=C1(1,29)+TDB*GC
      C1(2,29)=C1(2,29)+HDB*GCS+RDB*GC2
      C1(3,29)=C1(3,29)+HDB*GC2-RDB*GCS
      C1(4,29)=C1(4,29)+QDB*GC
      C1(5,29)=C1(5,29)-MDB*GC2
      C1(6,29)=C1(6,29)-MDB*GCS
      C1(1,30)=C1(1,30)+TDB*GS
      C1(2,30)=C1(2,30)+HDB*GS2+RDB*GCS
      C1(3,30)=C1(3,30)+HDB*GCS-RDB*GS2
      C1(4,30)=C1(4,30)+QDB*GS
      C1(5,30)=C1(5,30)-MDB*GCS
      C1(6,30)=C1(6,30)-MDB*GS2
      C1(1,27)=C1(1,27)+TDZ*G
      C1(2,27)=C1(2,27)+HDZ*G2S+RDZ*G2C
      C1(3,27)=C1(3,27)+HDZ*G2C-RDZ*G2S
      C1(4,27)=C1(4,27)+QDZ*G
      C1(5,27)=C1(5,27)-MDZ*G2C
      C1(6,27)=C1(6,27)-MDZ*G2S
      C0(1,27)=C0(1,27)+TZ*G
      C0(2,27)=C0(2,27)+HZ*G2S+RZ*G2C
      C0(3,27)=C0(3,27)+HZ*G2C-RZ*G2S
      C0(4,27)=C0(4,27)+QZ*G
      C0(5,27)=C0(5,27)-MZ*G2C
      C0(6,27)=C0(6,27)-MZ*G2S
      CA1(1,1)=CA1(1,1)-TU*GS
      CA1(1,2)=CA1(1,2)+TU*GC
      CA1(1,3)=CA1(1,3)+TL*G
      CA1(1,4)=CA1(1,4)+TDB*GS
      CA1(1,5)=CA1(1,5)-TDB*GC
      CA1(1,6)=CA1(1,6)+TDZ*G
      CA1(2,1)=CA1(2,1)-HU*GS2-RU*GC2-RR*GCS
      CA1(2,2)=CA1(2,2)+HU*GCS-RU*GCS+RR*GC2
      CA1(2,3)=CA1(2,3)+HL*G2S+RL*G2C
      CA1(2,4)=CA1(2,4)+HDB*GS2+RDB*GCS
      CA1(2,5)=CA1(2,5)-HDB*GCS-RDB*GC2
      CA1(2,6)=CA1(2,6)+HDZ*G2S+RDZ*G2C
      CA1(3,1)=CA1(3,1)-HU*GCS+RU*GCS+RR*GS2
      CA1(3,2)=CA1(3,2)+HU*GC2+RU*GS2-RR*GCS
      CA1(3,3)=CA1(3,3)+HL*G2C-RL*G2S
      CA1(3,4)=CA1(3,4)+HDB*GCS-RDB*GS2
      CA1(3,5)=CA1(3,5)-HDB*GC2+RDB*GCS
      CA1(3,6)=CA1(3,6)+HDZ*G2C-RDZ*G2S
      CA1(4,1)=CA1(4,1)-QU*GS
      CA1(4,2)=CA1(4,2)+QU*GC
      CA1(4,3)=CA1(4,3)+QL*G
      CA1(4,4)=CA1(4,4)+QDB*GS
      CA1(4,5)=CA1(4,5)-QDB*GC
      CA1(4,6)=CA1(4,6)+QDZ*G
      CA1(5,1)=CA1(5,1)+MMU*GCS
      CA1(5,2)=CA1(5,2)-MMU*GC2
      CA1(5,3)=CA1(5,3)-ML*G2C
      CA1(5,4)=CA1(5,4)-MDB*GCS
      CA1(5,5)=CA1(5,5)+MDB*GC2
      CA1(5,6)=CA1(5,6)-MDZ*G2C
      CA1(6,1)=CA1(6,1)+MMU*GS2
      CA1(6,2)=CA1(6,2)-MMU*GCS
      CA1(6,3)=CA1(6,3)-ML*G2S
      CA1(6,4)=CA1(6,4)-MDB*GS2
      CA1(6,5)=CA1(6,5)+MDB*GCS
      CA1(6,6)=CA1(6,6)-MDZ*G2S
      HU1=HU*GS2+RU*GC2+RR*GCS
      HU2=HU*GCS-RU*GCS-RR*GS2
      HL1=HL*G2S+RL*G2C
      HL2=HL*G2C-RL*G2S
      CA0(1,4)=CA0(1,4)+TU*LAMDA*GC-TL*MUY*G
      CA0(1,5)=CA0(1,5)+TU*LAMDA*GS-TL*MU*G
      CA0(1,6)=CA0(1,6)+TZ*G
      CA0(2,4)=CA0(2,4)+LAMDA*(HU*GCS-RU*GCS+RR*GC2)-MUY*HL1
      CA0(2,5)=CA0(2,5)+LAMDA*HU1-MU*HL1
      CA0(2,6)=CA0(2,6)+HZ*G2S+RZ*G2C
      CA0(3,4)=CA0(3,4)+LAMDA*(HU*GC2+RU*GS2-RR*GCS)-MUY*HL2
      CA0(3,5)=CA0(3,5)+LAMDA*HU2-MU*HL2
      CA0(3,6)=CA0(3,6)+HZ*G2C-RZ*G2S
      CA0(4,4)=CA0(4,4)+QU*LAMDA*GC-QL*MUY*G
      CA0(4,5)=CA0(4,5)+QU*LAMDA*GS-QL*MU*G
      CA0(4,6)=CA0(4,6)+QZ*G
      CA0(5,4)=CA0(5,4)-MMU*LAMDA*GC2+ML*MUY*G2C
      CA0(5,5)=CA0(5,5)-MMU*LAMDA*GCS+ML*MU*G2C
      CA0(5,6)=CA0(5,6)-MZ*G2C
      CA0(6,4)=CA0(6,4)-MMU*LAMDA*GCS+ML*MUY*C2S
      CA0(6,5)=CA0(6,5)-MMU*LAMDA*GS2+ML*MU*G2S
      CA0(6,6)=CA0(6,6)-MZ*G2S
      DG(1,1)=DG(1,1)+TU*GS
      DG(1,2)=DG(1,2)+TU*GC
      DG(1,3)=DG(1,3)-TL*G
      DG(2,1)=DG(2,1)+HU1
      DG(2,2)=DG(2,2)+HU*GCS-RU*GCS+RR*GC2
      DG(2,3)=DG(2,3)-HL1
      DG(3,1)=DG(3,1)+HU2
      DG(3,2)=DG(3,2)+HU*GC2+RU*GS2-RR*GCS
      DG(3,3)=DG(3,3)-HL2
      DG(4,1)=DG(4,1)+QU*GS
      DG(4,2)=DG(4,2)+QU*GC
      DG(4,3)=DG(4,3)-QL*G
      DG(5,1)=DG(5,1)-MMU*GCS
      DG(5,2)=DG(5,2)-MMU*GC2
      DG(5,3)=DG(5,3)+ML*G2C
      DG(6,1)=DG(6,1)-MMU*GS2
      DG(6,2)=DG(6,2)-MMU*GCS
      DG(6,3)=DG(6,3)+ML*G2S
    4 CONTINUE
      C=2.*GAMMA*DENSER/(5.7*SIGMA)*(LAMDA-MUZ)/SQRT(LAMDA**2/KHLMDA**4+-
     1(MU**2+MUY**2)/KFLMDA**2)
      DC=C*MU/KFLMDA**2
      AA1(28,1)=AA1(28,1)-DC
      BG(28,1)=BG(28,1)-DC
      DC=C*MUY/KFLMDA**2
      AA1(28,2)=AA1(28,2)+DC
      BG(28,2)=BG(28,2)-DC
      DC=C*LAMDA/KHLMDA**4
      AA1(28,3)=AA1(28,3)+DC
      BG(28,3)=BG(28,3)+DC
      IF (ROTATE .EQ. -1) CALL REQROT
      RETURN
      END
      SUBROUTINE AERO(PSI)
      COMMON /RINPUT/TYPE,NBLADE,DEL3G,NTRIM0,NTRIM1,MU,LAMDA,MTIP,NBM,N-
     1TM,GIMBAL,GAMMA,OMEGA,RADIUS,SIGMA,OPAERO,MRAERO,BBLD,RROOT,INCOMP-
     2,T1C,T1S,T75,MPSI,MREV,OPMODE,OFFSET,MRMODE,NONROT,NCOLB,CONE,IB,D-
     3EL1,XFA,KPG,GGS,GQS(5),GPS(3),NCOLT,WT0,RFA,HSPRC,HSPRS,KPB(5),RPH-
     4,XPH,WTCH,WTSH,WTRH,WTC,WTS,WTR,NUGC,NUGS,KFLAP,KLAG,HINGE,KPIN,AT-
     5ANKP(5),DROOP,SWEEP,DEL2,DEL3,ZFA,VTIPN,DEBUGR,EPMODE,GLAG,LDAMP,E-
     6XDAMP,PHIPH,PHIPL,LDAMPC,MUY,MUZ,CHORD(51),XA(51),MASS(51),XI(51),-
     7THETA(51),ITHETA(51),TWIST(51),EIZZ(51),EIXX(51),GJ(51),XC(51),DEN-
     8SER,OPUNIR,ELAG,VTOT,KHLMDA,KFLMDA,ALFHP,PSIHP,T75IN,T1CIN,T1SIN,I-
     9RING,ROTATE,FDROOP,FSWEEP,DEL4,DEL5
      REAL MU,LAMDA,MTIP,IB,MASS,ITHETA,KPG,NUGC,NUGS,KPB,KFLAP,KLAG,LDA-
     1MP,LDAMPC,MUY,MUZ,KHLMDA,KFLMDA
      INTEGER OPAERO,GIMBAL,OPMODE,HINGE,DEBUGR,OPUNIR,ROTATE
      COMMON /BINERT/   I0,SQ(5,2),IQA(5,2),SPA(3,2),IDQA(5),IDQP(5),IQ(-
     15),SQDDP(5,3),SQP(5,3),IQDQ(5,5),IP(3),SP(3,2),IPA(3,2),SPDDA(3),S-
     2PDDQ(3,5),SPQ(3,5),IPDDP(3,3),IPP(3,3),XATOR(3,2,51),DXATOR(3,5,2,-
     351),MASSB,IQDP(5)
      REAL MASSB,I0,IQA,IDQA,IDQP,IQ,IQDQ,IP,IPA,IPDDP,IPP,IQDP
      COMMON /ZTRIM/B0(5),B1C(5),B1S(5),B2C(5),B2S(5),BGC,BGS,HHHT(2348)
      COMMON /MODES/ETA(5,2,51),ETAP(5,2,51),ETAPP(5,2,51),NU(5),ZETA(3,-
     151),ZETAP(3,51),WT(3),EFA(5,2),EFAP(5,2),EFAPP(5,2)
      REAL NU
      COMMON /BAERO/MQU(5),MQDZ(5),MQZ(5),MQL(5),MQDB(5),MQB(5),MQDQ(5,5-
     1),MQQ(5,5),MQP(5,3),MMU,MDZ,MZ,ML,MDB,MB,MDQ(5),MQ(5),MP(3),TU,TDZ-
     2,TZ,TL,TDB,TB,TDQ(5),TQ(5),TP(3),HU,HDZ,HZ,HL,HDB,HB,HDQ(5),HQ(5),-
     3HP(3),QU,QDZ,QZ,QL,QDB,QB,QDQ(5),QQ(5),QP(3),RR,RU,RDZ,RZ,RL,RDB,R-
     4B,RDQ(5),RQ(5),RP(3),MPU(3),MPDZ(3),MPZ(3),MPL(3),MPDB(3),MPB(3),M-
     5PDQ(3,5),MPQ(3,5),MPP(3,3),MPDP(3,3),FZ0,FX0
      REAL MQU,MQDZ,MQZ,MQL,MQDB,MQB,MQDQ,MQQ,MQP,MMU,MDZ,MZ,ML,MDB,MB,M-
     1DQ,MQ,MP,MPU,MPDZ,MPZ,MPL,MPDB,MPB,MPDQ,MPQ,MPP,MPDP
      NAMELIST/NLDB/MQU,MQDZ,MQZ,MQL,MQDB,MQB,MQDQ,MQQ,MQP,MMU,MDZ,MZ,ML-
     1,MDB,MB,MDQ,MQ,MP,TU,TDZ,TZ,TL,TDB,TB,TDQ,TQ,TP,HU,HDZ,HZ,HL,HDB,H-
     2B,HDQ,HQ,HP,QU,QDZ,QZ,QL,QDB,QB,QDQ,QQ,QP,RR,RU,RDZ,RZ,RL,RDB,RB,R-
     3DQ,RQ,RP,MPU,MPDZ,MPZ,MPL,MPDB,MPB,MPDQ,MPQ,MPP,MPDP,FZ0,FX0
      REAL ZERO(259),QTRIM(5),DQTRIM(5),MACH,MAT,MAP,MAA,MUCS,MUSN
      EQUIVALENCE (ZERO(1),MQU(1))
      EQUIVALENCE (MR,MRAERO)
      DATA CLA,CL,CLM,CD,CDA,CDM,CM,CMA,CMM/.5,8*0./
      CMEAN=3.141593*SIGMA/FLOAT(NBLADE)
      DO 10 I=NTRIM0,NTRIM1
   10 QTRIM(I)=B0(I)
      IF (VTOT .EQ. 0.) GO TO 11
      CS=COS(PSI)
      SN=SIN(PSI)
      CS2=CS*CS-SN*SN
      SN2=2.*CS*SN
      MUCS=MU*CS-MUY*SN
      MUSN=MU*SN+MUY*CS
      DO 12 I=NTRIM0,NTRIM1
      QTRIM(I)=B0(I)+B1C(I)*CS+B1S(I)*SN+B2C(I)*CS2+B2S(I)*SN2
   12 DQTRIM(I)=-B1C(I)*SN+B1S(I)*CS-2.*B2C(I)*SN2+2.*B2S(I)*CS2
      TCYC=T1C*CS+T1S*SN
      BETA=0.
      DBETA=0.
      IF (GIMBAL .EQ. 0) GO TO 11
      BETA=BGC*CS+BGS*SN
      DBETA=-BGC*SN+BGS*CS
      TCYC=TCYC-KPG*BETA
   11 CONTINUE
      DO 13 I=1,259
   13 ZERO(I)=0.
      DR=(1.-RROOT)/FLOAT(MR)
      MR1=MR+1
      DO 1 JR=1,MR1
      R=FLOAT(JR-1)*DR+RROOT
      IR=IFIX(R*50.+.5)+1
      H=DR
      IF ((JR .EQ. 1) .OR. (JR .EQ. MR1)) H=.5*DR
      H=H*CHORD(IR)/CMEAN
      UT=R
      UP=LAMDA
      UR=XFA-LAMDA*DEL1+RFA*DEL3+LAMDA*DEL2
      T=THETA(IR)
      SNT=SIN(T)
      CST=COS(T)
      SLOPEZ=DEL1-DEL2+BETA
      SLOPEX=DEL3
      DO 21 I=NTRIM0,NTRIM1
      UR=UR+QTRIM(I)*(ETA(I,2,IR)-R*ETAP(I,2,IR)-LAMDA*ETAP(I,1,IR))
      T=T-KPB(I)*QTRIM(I)
      SLOPEZ=SLOPEZ+QTRIM(I)*ETAP(I,1,IR)
   21 SLOPEX=SLOPEX-QTRIM(I)*ETAP(I,2,IR)
      IF (VTOT .EQ. 0.) GO TO 22
      UT=UT+MUSN-MUCS*DEL3
      UP=UP+R*DBETA+MUCS*(DEL1+BETA-DEL2)
      UR=UR+MUCS-LAMDA*BETA+MUSN*DEL3
      T=T+TCYC
      DO 23 I=NTRIM0,NTRIM1
      UT=UT+QTRIM(I)*MUCS *ETAP(I,2,IR)+DQTRIM(I)*ETA(I,2,IR)
      UP=UP+DQTRIM(I)*ETA(I,1,IR)+QTRIM(I)*MUCS *ETAP(I,1,IR)
   23 UR=UR-QTRIM(I)*MUSN *ETAP(I,2,IR)
   22 CONTINUE
      ALF=T-ATAN2(UP,UT)
      U=SQRT(UT*UT+UP*UP)
      MACH=MTIP*U
      UP2=UP*UP
      UT2=UT*UT
      UPT=UP*UT
      IF (OPAERO .EQ. 0) GO TO 24
      CALL SEXION (ALF,MACH,CL,CLA,CLM,CD,CDA,CDM,CM,CMA,CMM,OPAERO,R)
      IF (R .LE. BBLD) GO TO 24
      CL=CL*AMAX1(0.,1.-2.*(1.-BBLD)/DR)
      CLM=CLM*AMAX1(0.,1.-2.*(1.-BBLD)/DR)
   24 CONTINUE
      X=XA(IR)
      IF (UT .LT. 0.) X=-(XA(IR)+.5*CHORD(IR))
      C=CHORD(IR)
      CZ=UT*CLA-UP*CDA
      CX=UP*CLA+UT*CDA
      CA=-X*CLA+C*CMA
      FZ=U*(UT*CL-UP*CD)
      FX=U*(UP*CL+UT*CD)
      FZA=U*CZ
      FZP=(-UT*CZ+CLM*UPT-CDM*UP2)/U-CD*U
      FZT=(UP*CZ+CLM*UT2-CDM*UPT)/U+CL*U
      FXA=U*CX
      FXP=(-UT*CX+CLM*UP2+CDM*UPT)/U+CL*U
      FXT=(UP*CX+CLM*UPT+CDM*UT2)/U+CD*U
      FRA=U*UR*CDA
      FRP=UR*(-UT*CDA+CDM*UP)/U
      FRT=UR*(UP*CDA+CDM*UT)/U
      FRR=U*CD
      FRA=FRA-FZA*SLOPEZ-FXA*SLOPEX
      FRP=FRP-FZP*SLOPEZ-FXP*SLOPEX
      FRT=FRT-FZT*SLOPEZ-FXT*SLOPEX
      MAA=U*U*CA
      MAP=-UT*CA-X*UP*(CL+CLM)+C*UP*(CM+CMM)
      MAT=UP*CA-X*UT*(CL+CLM)+C*UT*(CM+CMM)
      UR=0.
      IF (VTOT .NE. 0.) UR=MU*CS-MUY*SN
      DO 31 I=1,NBM
      EI=ETA(I,1,IR)
      EK=ETA(I,2,IR)
      CT=EI*FZT-EK*FXT
      CP=EI*FZP-EK*FXP
      MQU(I)=MQU(I)+H*CT
      MQDZ(I)=MQDZ(I)+H*CT*R
      MQL(I)=MQL(I)+H*CP
      MQDB(I)=MQDB(I)+H*CP*R
      DO 32 K=1,NBM
      MQDQ(I,K)=MQDQ(I,K)+H*(CT*ETA(K,2,IR)+CP*ETA(K,1,IR))
   32 MQQ(I,K)=MQQ(I,K)+H*UR*(CT*ETAP(K,2,IR)+CP*ETAP(K,1,IR))
      DO 31 K=1,NTM
   31 MQP(I,K)=MQP(I,K)+H*(EI*FZA-EK*FXA)*ZETA(K,IR)
      MMU=MMU+H*FZT*R
      MDZ=MDZ+H*FZT*R*R
      ML=ML+H*FZP*R
      MDB=MDB+H*FZP*R*R
      FZ0=FZ0+H*FZ*5.7
      TU=TU+H*FZT
      TL=TL+H*FZP
      FX0=FX0+H*FX*R*5.7
      QU=QU+H*FXT*R
      QDZ=QDZ+H*FXT*R*R
      QL=QL+H*FXP*R
      QDB=QDB+H*FXP*R*R
      HU=HU+H*FXT
      HL=HL+H*FXP
      RU=RU+H*FRR
      RR=RR+H*FRT
      RDZ=RDZ+H*FRT*R
      RL=RL+H*FRP
      RDB=RDB+H*FRP*R
      RZ=RZ-H*FX
      RB=RB-H*FZ
      DO 34 I=1,NBM
      EI=ETA(I,1,IR)
      EK=ETA(I,2,IR)
      MDQ(I)=MDQ(I)+H*(FZT*EK+FZP*EI)*R
      TDQ(I)=TDQ(I)+H*(FZT*EK+FZP*EI)
      QDQ(I)=QDQ(I)+H*(FXT*EK+FXP*EI)*R
      HDQ(I)=HDQ(I)+H*(FXT*EK+FXP*EI)
      RDQ(I)=RDQ(I)+H*(FRT*EK+FRP*EI)
      EI=ETAP(I,1,IR)
      EK=ETAP(I,2,IR)
      MQ(I)=MQ(I)+H*UR*(FZT*EK+FZP*EI)*R
      TQ(I)=TQ(I)+H*UR*(FZT*EK+FZP*EI)
      QQ(I)=QQ(I)+H*UR*(FXT*EK+FXP*EI)*R
      HQ(I)=HQ(I)+H*UR*(FXT*EK+FXP*EI)
      RQ(I)=RQ(I)+H*(UR*(FRT*EK+FRP*EI)+FRR*(ETA(I,2,IR)-R*EK-LAMDA*EI)--
     1FZ*EI-FX*EK)
      IF (VTOT .NE. 0.) RQ(I)=RQ(I)-H*FRR*MUSN*EK
   34 CONTINUE
      DO 35 I=1,NTM
      Z=ZETA(I,IR)
      MP(I)=MP(I)+H*FZA*Z*R
      TP(I)=TP(I)+H*FZA*Z
      QP(I)=QP(I)+H*FXA*Z*R
      HP(I)=HP(I)+H*FXA*Z
   35 RP(I)=RP(I)+H*FRA*Z
      UT1=UT*CST+UP*SNT
      DO 36 I=1,NTM
      Z=ZETA(I,IR)
      ZC=Z*C*C/32.
      XA1=(1.+4.*X/C)*ZC
      XA2=(1.+8.*X/C+16.*(X/C)**2)*ZC
      IF (UT1 .LT. 0.) XA1=-XA1
      IF (UT1 .LT. 0.) XA2=-XA2
      IF (( ABS(ALF) .LT. .21) .OR. (OPAERO .LT. 0)) GO TO 136
      XA1=0.
      XA2=0.
  136 CONTINUE
      CT=Z*MAT-FXT*XATOR(I,1,IR)-FZT*XATOR(I,2,IR)
      CP=Z*MAP-FXP*XATOR(I,1,IR)-FZP*XATOR(I,2,IR)
      MPU(I)=MPU(I)+H*CT
      MPDZ(I)=MPDZ(I)+H*(CT*R-XA1*2.*UR*SNT)
      IF (VTOT.NE.0.) MPZ(I)=MPZ(I)+H*XA1*MUSN*SNT
      MPL(I)=MPL(I)+H*CP
      MPDB(I)=MPDB(I)+H*(CP*R+XA1*2.*UR*CST)
      MPB(I)=MPB(I)-H*XA2*UT1
      IF (VTOT.NE.0.) MPB(I)=MPB(I)-H*XA1*MUSN*CST
      DO 37 K=1,NBM
      EI=ETAP(K,1,IR)
      EK=ETAP(K,2,IR)
      MPDQ(I,K)=MPDQ(I,K)+H*(CT*ETA(K,2,IR)+CP*ETA(K,1,IR)+XA1*2.*UR*(EI-
     1*CST-EK*SNT))
      MPQ(I,K)=MPQ(I,K)+H*(UR*(CT*EK+CP*EI)-(FX*DXATOR(I,K,1,IR)+FZ*DXAT-
     1OR(I,K,2,IR))-XA2*UT1*EI)
      IF (VTOT.NE.0.) MPQ(I,K)=MPQ(I,K)-H*XA1*(MUSN *(EI*CST-EK*SNT)-(MU-
     1SN )**2*(ETAPP(K,1,IR)*CST-ETAPP(K,2,IR)*SNT))
   37 CONTINUE
      CA=Z*MAA-FXA*XATOR(I,1,IR)-FZA*XATOR(I,2,IR)
      DO 38 K=1,NTM
      ZK=ZETA(K,IR)
      MPP(I,K)=MPP(I,K)+H*(CA*ZK-XA1*UR*(ZETAP(K,IR)*UT1))
   38 MPDP(I,K)=MPDP(I,K)-H*(XA1+XA2)*ZK*UT1
   36 CONTINUE
    1 CONTINUE
      TDZ=MMU
      TDB=ML
      HDZ=QU
      HDB=QL
      RB=RB-LAMDA*RU
      IF (VTOT .EQ. 0.) GO TO 40
      UR=MU*CS-MUY*SN
      DO 41 I=1,NBM
      MQZ(I)=UR*MQU(I)
   41 MQB(I)=UR*MQL(I)
      MZ=UR*MMU
      MB=UR*ML
      TZ=UR*TU
      TB=UR*TL
      QZ=UR*QU
      QB=UR*QL
      HZ=UR*HU
      HB=UR*HL
      RZ=RZ+UR*RR-MUSN*RU
      RB=RB+UR*RL
      DO 42 I=1,NTM
      MPZ(I)=MPZ(I)+UR*MPU(I)
   42 MPB(I)=MPB(I)+UR*MPL(I)
   40 CONTINUE
      IF (DEBUGR .NE. 0) WRITE(6,NLDB)
      RETURN
      END
      SUBROUTINE SEXION(ALF,MACH,CL,CLA,CLM,CD,CDA,CDM,CM,CMA,CMM,OP,R)
      REAL MACH,MLDIV
      DATA MLDIV/.75/
      INTEGER OP
      IF (OP .LT. 0) GO TO 1
      IF (ABS(ALF) .GT. .21) GO TO 2
    1 BETA=1./AMAX1(.31,SQRT(ABS(1.-MACH**2)))
      CL=.5*ALF*BETA
      CLA=.5*BETA
      CLM=CL*BETA**2
      IF (MACH .LE. MLDIV) GO TO 5
      CLA=.5*AMAX1(0.,1.-MACH)/((1.-MLDIV)*SQRT(1.-MLDIV**2))
      CL=CLA*ALF
      CLM=CL*(1.-2.*MACH)/(1.-MACH)
    5 CM=0.
      CMA=0.
      CMM=0.
      CD=.0065-.0216*ALF+.4*ALF*ALF
      CDA=-.0216+.8*ALF
      CDM=CD
      IF (MACH .LE. 0.) GO TO 3
      ADIV=AMAX1(0.,.26*(.9-MACH))
      IF (ABS(ALF) .LT. ADIV) GO TO 3
      CD=CD+1.65*(ABS(ALF)-ADIV)
      CDA=CDA+SIGN(1.65,ALF)
      CDM=CD
      IF (MACH .LT. .9) CDM=CDM+.43
    3 CD=CD*.088
      CDA=CDA*.088
      CDM=CDM*.088
      RETURN
    2 CD=2.*(SIN(ALF))**2*.088
      CDA=2.*SIN(2.*ALF)*.088
      CDM=CD
      IF (ABS(ALF) .GT. 1.04) GO TO 4
      CL=SIGN(.088,ALF)
      CLA=0.
      CLM=CL
      CM=-.15*SIGN(1.,ALF)
      CMA=0.
      CMM=CM
      RETURN
    4 CL=SIGN(.088,ALF)*(3.-1.91*ABS(ALF))
      CLA=-.16808
      CLM=CL
      CM=-.4*SIGN(1.,ALF)
      CMA=0.
      CMM=CM
      RETURN
      END
